85fd9ebaf55f01179e5a791b89fce748f5b5f844
[ghc.git] / compiler / coreSyn / CoreUnfold.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The AQUA Project, Glasgow University, 1994-1998
4 %
5
6 Core-syntax unfoldings
7
8 Unfoldings (which can travel across module boundaries) are in Core
9 syntax (namely @CoreExpr@s).
10
11 The type @Unfolding@ sits ``above'' simply-Core-expressions
12 unfoldings, capturing ``higher-level'' things we know about a binding,
13 usually things that the simplifier found out (e.g., ``it's a
14 literal'').  In the corner of a @CoreUnfolding@ unfolding, you will
15 find, unsurprisingly, a Core expression.
16
17 \begin{code}
18 {-# OPTIONS -fno-warn-tabs #-}
19 -- The above warning supression flag is a temporary kludge.
20 -- While working on this module you are encouraged to remove it and
21 -- detab the module (please do the detabbing in a separate patch). See
22 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
23 -- for details
24
25 module CoreUnfold (
26         Unfolding, UnfoldingGuidance,   -- Abstract types
27
28         noUnfolding, mkImplicitUnfolding, 
29         mkUnfolding, mkCoreUnfolding,
30         mkTopUnfolding, mkSimpleUnfolding,
31         mkInlineUnfolding, mkInlinableUnfolding, mkWwInlineRule,
32         mkCompulsoryUnfolding, mkDFunUnfolding,
33
34         interestingArg, ArgSummary(..),
35
36         couldBeSmallEnoughToInline, inlineBoringOk,
37         certainlyWillInline, smallEnoughToInline,
38
39         callSiteInline, CallCtxt(..),
40
41         -- Reexport from CoreSubst (it only live there so it can be used
42         -- by the Very Simple Optimiser)
43         exprIsConApp_maybe, exprIsLiteral_maybe
44     ) where
45
46 #include "HsVersions.h"
47
48 import StaticFlags
49 import DynFlags
50 import CoreSyn
51 import PprCore          ()      -- Instances
52 import TcType           ( tcSplitDFunTy )
53 import OccurAnal        ( occurAnalyseExpr )
54 import CoreSubst hiding( substTy )
55 import CoreArity       ( manifestArity, exprBotStrictness_maybe )
56 import CoreUtils
57 import Id
58 import DataCon
59 import Literal
60 import PrimOp
61 import IdInfo
62 import BasicTypes       ( Arity )
63 import Type
64 import PrelNames
65 import Bag
66 import Util
67 import FastTypes
68 import FastString
69 import Outputable
70 import ForeignCall
71
72 import Data.Maybe
73 \end{code}
74
75
76 %************************************************************************
77 %*                                                                      *
78 \subsection{Making unfoldings}
79 %*                                                                      *
80 %************************************************************************
81
82 \begin{code}
83 mkTopUnfolding :: Bool -> CoreExpr -> Unfolding
84 mkTopUnfolding = mkUnfolding InlineRhs True {- Top level -}
85
86 mkImplicitUnfolding :: CoreExpr -> Unfolding
87 -- For implicit Ids, do a tiny bit of optimising first
88 mkImplicitUnfolding expr = mkTopUnfolding False (simpleOptExpr expr) 
89
90 -- Note [Top-level flag on inline rules]
91 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
92 -- Slight hack: note that mk_inline_rules conservatively sets the
93 -- top-level flag to True.  It gets set more accurately by the simplifier
94 -- Simplify.simplUnfolding.
95
96 mkSimpleUnfolding :: CoreExpr -> Unfolding
97 mkSimpleUnfolding = mkUnfolding InlineRhs False False
98
99 mkDFunUnfolding :: Type -> [DFunArg CoreExpr] -> Unfolding
100 mkDFunUnfolding dfun_ty ops 
101   = DFunUnfolding dfun_nargs data_con ops
102   where
103     (tvs, n_theta, cls, _) = tcSplitDFunTy dfun_ty
104     dfun_nargs = length tvs + n_theta
105     data_con   = classDataCon cls
106
107 mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding
108 mkWwInlineRule id expr arity
109   = mkCoreUnfolding (InlineWrapper id) True
110                    (simpleOptExpr expr) arity
111                    (UnfWhen unSaturatedOk boringCxtNotOk)
112
113 mkCompulsoryUnfolding :: CoreExpr -> Unfolding
114 mkCompulsoryUnfolding expr         -- Used for things that absolutely must be unfolded
115   = mkCoreUnfolding InlineCompulsory True
116                     (simpleOptExpr expr) 0    -- Arity of unfolding doesn't matter
117                     (UnfWhen unSaturatedOk boringCxtOk)
118
119 mkInlineUnfolding :: Maybe Arity -> CoreExpr -> Unfolding
120 mkInlineUnfolding mb_arity expr 
121   = mkCoreUnfolding InlineStable
122                     True         -- Note [Top-level flag on inline rules]
123                     expr' arity 
124                     (UnfWhen unsat_ok boring_ok)
125   where
126     expr' = simpleOptExpr expr
127     (unsat_ok, arity) = case mb_arity of
128                           Nothing -> (unSaturatedOk, manifestArity expr')
129                           Just ar -> (needSaturated, ar)
130               
131     boring_ok = inlineBoringOk expr'
132
133 mkInlinableUnfolding :: CoreExpr -> Unfolding
134 mkInlinableUnfolding expr
135   = mkUnfolding InlineStable True is_bot expr'
136   where
137     expr' = simpleOptExpr expr
138     is_bot = isJust (exprBotStrictness_maybe expr')
139 \end{code}
140
141 Internal functions
142
143 \begin{code}
144 mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
145                 -> Arity -> UnfoldingGuidance -> Unfolding
146 -- Occurrence-analyses the expression before capturing it
147 mkCoreUnfolding src top_lvl expr arity guidance 
148   = CoreUnfolding { uf_tmpl         = occurAnalyseExpr expr,
149                     uf_src          = src,
150                     uf_arity        = arity,
151                     uf_is_top       = top_lvl,
152                     uf_is_value     = exprIsHNF        expr,
153                     uf_is_conlike   = exprIsConLike    expr,
154                     uf_is_work_free = exprIsWorkFree   expr,
155                     uf_expandable   = exprIsExpandable expr,
156                     uf_guidance     = guidance }
157
158 mkUnfolding :: UnfoldingSource -> Bool -> Bool -> CoreExpr -> Unfolding
159 -- Calculates unfolding guidance
160 -- Occurrence-analyses the expression before capturing it
161 mkUnfolding src top_lvl is_bottoming expr
162   | top_lvl && is_bottoming
163   , not (exprIsTrivial expr)
164   = NoUnfolding    -- See Note [Do not inline top-level bottoming functions]
165   | otherwise
166   = CoreUnfolding { uf_tmpl         = occurAnalyseExpr expr,
167                     uf_src          = src,
168                     uf_arity        = arity,
169                     uf_is_top       = top_lvl,
170                     uf_is_value     = exprIsHNF        expr,
171                     uf_is_conlike   = exprIsConLike    expr,
172                     uf_expandable   = exprIsExpandable expr,
173                     uf_is_work_free = exprIsWorkFree   expr,
174                     uf_guidance     = guidance }
175   where
176     (arity, guidance) = calcUnfoldingGuidance expr
177         -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
178         -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
179 \end{code}
180
181 Note [Calculate unfolding guidance on the non-occ-anal'd expression]
182 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
183 Notice that we give the non-occur-analysed expression to
184 calcUnfoldingGuidance.  In some ways it'd be better to occur-analyse
185 first; for example, sometimes during simplification, there's a large
186 let-bound thing which has been substituted, and so is now dead; so
187 'expr' contains two copies of the thing while the occurrence-analysed
188 expression doesn't.
189
190 Nevertheless, we *don't* and *must not* occ-analyse before computing
191 the size because 
192
193 a) The size computation bales out after a while, whereas occurrence
194    analysis does not.
195
196 b) Residency increases sharply if you occ-anal first.  I'm not 
197    100% sure why, but it's a large effect.  Compiling Cabal went 
198    from residency of 534M to over 800M with this one change.
199
200 This can occasionally mean that the guidance is very pessimistic;
201 it gets fixed up next round.  And it should be rare, because large
202 let-bound things that are dead are usually caught by preInlineUnconditionally
203
204
205 %************************************************************************
206 %*                                                                      *
207 \subsection{The UnfoldingGuidance type}
208 %*                                                                      *
209 %************************************************************************
210
211 \begin{code}
212 inlineBoringOk :: CoreExpr -> Bool
213 -- See Note [INLINE for small functions]
214 -- True => the result of inlining the expression is 
215 --         no bigger than the expression itself
216 --     eg      (\x y -> f y x)
217 -- This is a quick and dirty version. It doesn't attempt
218 -- to deal with  (\x y z -> x (y z))
219 -- The really important one is (x `cast` c)
220 inlineBoringOk e
221   = go 0 e
222   where
223     go :: Int -> CoreExpr -> Bool
224     go credit (Lam x e) | isId x           = go (credit+1) e
225                         | otherwise        = go credit e
226     go credit (App f (Type {}))            = go credit f
227     go credit (App f a) | credit > 0  
228                         , exprIsTrivial a  = go (credit-1) f
229     go credit (Tick _ e)                 = go credit e -- dubious
230     go credit (Cast e _)                   = go credit e
231     go _      (Var {})                     = boringCxtOk
232     go _      _                            = boringCxtNotOk
233
234 calcUnfoldingGuidance
235         :: CoreExpr     -- Expression to look at
236         -> (Arity, UnfoldingGuidance)
237 calcUnfoldingGuidance expr
238   = case collectBinders expr of { (bndrs, body) ->
239     let
240         bOMB_OUT_SIZE = opt_UF_CreationThreshold 
241                -- Bomb out if size gets bigger than this
242         val_bndrs   = filter isId bndrs
243         n_val_bndrs = length val_bndrs
244
245         guidance 
246           = case (sizeExpr (iUnbox bOMB_OUT_SIZE) val_bndrs body) of
247               TooBig -> UnfNever
248               SizeIs size cased_bndrs scrut_discount
249                 | uncondInline expr n_val_bndrs (iBox size)
250                 -> UnfWhen unSaturatedOk boringCxtOk   -- Note [INLINE for small functions]
251                 | otherwise
252                 -> UnfIfGoodArgs { ug_args  = map (discount cased_bndrs) val_bndrs
253                                  , ug_size  = iBox size
254                                  , ug_res   = iBox scrut_discount }
255
256         discount :: Bag (Id,Int) -> Id -> Int
257         discount cbs bndr = foldlBag combine 0 cbs
258            where
259              combine acc (bndr', disc) 
260                | bndr == bndr' = acc `plus_disc` disc
261                | otherwise     = acc
262    
263              plus_disc :: Int -> Int -> Int
264              plus_disc | isFunTy (idType bndr) = max
265                        | otherwise             = (+)
266              -- See Note [Function and non-function discounts]
267     in
268     (n_val_bndrs, guidance) }
269 \end{code}
270
271 Note [Computing the size of an expression]
272 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
273 The basic idea of sizeExpr is obvious enough: count nodes.  But getting the
274 heuristics right has taken a long time.  Here's the basic strategy:
275
276     * Variables, literals: 0
277       (Exception for string literals, see litSize.)
278
279     * Function applications (f e1 .. en): 1 + #value args
280
281     * Constructor applications: 1, regardless of #args
282
283     * Let(rec): 1 + size of components
284
285     * Note, cast: 0
286
287 Examples
288
289   Size  Term
290   --------------
291     0     42#
292     0     x
293     0     True
294     2     f x
295     1     Just x
296     4     f (g x)
297
298 Notice that 'x' counts 0, while (f x) counts 2.  That's deliberate: there's
299 a function call to account for.  Notice also that constructor applications 
300 are very cheap, because exposing them to a caller is so valuable.
301
302 [25/5/11] All sizes are now multiplied by 10, except for primops
303 (which have sizes like 1 or 4.  This makes primops look fantastically
304 cheap, and seems to be almost unversally beneficial.  Done partly as a
305 result of #4978.
306
307 Note [Do not inline top-level bottoming functions]
308 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
309 The FloatOut pass has gone to some trouble to float out calls to 'error' 
310 and similar friends.  See Note [Bottoming floats] in SetLevels.
311 Do not re-inline them!  But we *do* still inline if they are very small
312 (the uncondInline stuff).
313
314 Note [INLINE for small functions]
315 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
316 Consider        {-# INLINE f #-}
317                 f x = Just x
318                 g y = f y
319 Then f's RHS is no larger than its LHS, so we should inline it into
320 even the most boring context.  In general, f the function is
321 sufficiently small that its body is as small as the call itself, the
322 inline unconditionally, regardless of how boring the context is.
323
324 Things to note:
325
326 (1) We inline *unconditionally* if inlined thing is smaller (using sizeExpr)
327     than the thing it's replacing.  Notice that
328       (f x) --> (g 3)             -- YES, unconditionally
329       (f x) --> x : []            -- YES, *even though* there are two
330                                   --      arguments to the cons
331       x     --> g 3               -- NO
332       x     --> Just v            -- NO
333
334     It's very important not to unconditionally replace a variable by
335     a non-atomic term.
336
337 (2) We do this even if the thing isn't saturated, else we end up with the
338     silly situation that
339        f x y = x
340        ...map (f 3)...
341     doesn't inline.  Even in a boring context, inlining without being
342     saturated will give a lambda instead of a PAP, and will be more
343     efficient at runtime.
344
345 (3) However, when the function's arity > 0, we do insist that it 
346     has at least one value argument at the call site.  (This check is
347     made in the UnfWhen case of callSiteInline.) Otherwise we find this:
348          f = /\a \x:a. x
349          d = /\b. MkD (f b)
350     If we inline f here we get
351          d = /\b. MkD (\x:b. x)
352     and then prepareRhs floats out the argument, abstracting the type
353     variables, so we end up with the original again!
354
355 (4) We must be much more cautious about arity-zero things. Consider
356        let x = y +# z in ...
357     In *size* terms primops look very small, because the generate a
358     single instruction, but we do not want to unconditionally replace
359     every occurrence of x with (y +# z).  So we only do the
360     unconditional-inline thing for *trivial* expressions.
361   
362     NB: you might think that PostInlineUnconditionally would do this
363     but it doesn't fire for top-level things; see SimplUtils
364     Note [Top level and postInlineUnconditionally]
365
366 \begin{code}
367 uncondInline :: CoreExpr -> Arity -> Int -> Bool
368 -- Inline unconditionally if there no size increase
369 -- Size of call is arity (+1 for the function)
370 -- See Note [INLINE for small functions]
371 uncondInline rhs arity size 
372   | arity > 0 = size <= 10 * (arity + 1) -- See Note [INLINE for small functions] (1)
373   | otherwise = exprIsTrivial rhs        -- See Note [INLINE for small functions] (4)
374 \end{code}
375
376
377 \begin{code}
378 sizeExpr :: FastInt         -- Bomb out if it gets bigger than this
379          -> [Id]            -- Arguments; we're interested in which of these
380                             -- get case'd
381          -> CoreExpr
382          -> ExprSize
383
384 -- Note [Computing the size of an expression]
385
386 sizeExpr bOMB_OUT_SIZE top_args expr
387   = size_up expr
388   where
389     size_up (Cast e _) = size_up e
390     size_up (Tick _ e) = size_up e
391     size_up (Type _)   = sizeZero           -- Types cost nothing
392     size_up (Coercion _) = sizeZero
393     size_up (Lit lit)  = sizeN (litSize lit)
394     size_up (Var f)    = size_up_call f []  -- Make sure we get constructor
395                                             -- discounts even on nullary constructors
396
397     size_up (App fun (Type _)) = size_up fun
398     size_up (App fun (Coercion _)) = size_up fun
399     size_up (App fun arg)      = size_up arg  `addSizeNSD`
400                                  size_up_app fun [arg]
401
402     size_up (Lam b e) | isId b    = lamScrutDiscount (size_up e `addSizeN` 10)
403                       | otherwise = size_up e
404
405     size_up (Let (NonRec binder rhs) body)
406       = size_up rhs             `addSizeNSD`
407         size_up body            `addSizeN`
408         (if isUnLiftedType (idType binder) then 0 else 10)
409                 -- For the allocation
410                 -- If the binder has an unlifted type there is no allocation
411
412     size_up (Let (Rec pairs) body)
413       = foldr (addSizeNSD . size_up . snd) 
414               (size_up body `addSizeN` (10 * length pairs))     -- (length pairs) for the allocation
415               pairs
416
417     size_up (Case (Var v) _ _ alts) 
418         | v `elem` top_args             -- We are scrutinising an argument variable
419         = alts_size (foldr addAltSize sizeZero alt_sizes)
420                     (foldr maxSize    sizeZero alt_sizes)
421                 -- Good to inline if an arg is scrutinised, because
422                 -- that may eliminate allocation in the caller
423                 -- And it eliminates the case itself
424         where
425           alt_sizes = map size_up_alt alts
426
427                 -- alts_size tries to compute a good discount for
428                 -- the case when we are scrutinising an argument variable
429           alts_size (SizeIs tot tot_disc tot_scrut)  -- Size of all alternatives
430                     (SizeIs max _        _)          -- Size of biggest alternative
431                 = SizeIs tot (unitBag (v, iBox (_ILIT(20) +# tot -# max)) `unionBags` tot_disc) tot_scrut
432                         -- If the variable is known, we produce a discount that
433                         -- will take us back to 'max', the size of the largest alternative
434                         -- The 1+ is a little discount for reduced allocation in the caller
435                         --
436                         -- Notice though, that we return tot_disc, the total discount from 
437                         -- all branches.  I think that's right.
438
439           alts_size tot_size _ = tot_size
440
441     size_up (Case e _ _ alts) = size_up e  `addSizeNSD`
442                                 foldr (addAltSize . size_up_alt) case_size alts
443       where
444           case_size
445            | is_inline_scrut e, not (lengthExceeds alts 1)  = sizeN (-10)
446            | otherwise = sizeZero
447                 -- Normally we don't charge for the case itself, but
448                 -- we charge one per alternative (see size_up_alt,
449                 -- below) to account for the cost of the info table
450                 -- and comparisons.
451                 --
452                 -- However, in certain cases (see is_inline_scrut
453                 -- below), no code is generated for the case unless
454                 -- there are multiple alts.  In these cases we
455                 -- subtract one, making the first alt free.
456                 -- e.g. case x# +# y# of _ -> ...   should cost 1
457                 --      case touch# x# of _ -> ...  should cost 0
458                 -- (see #4978)
459                 --
460                 -- I would like to not have the "not (lengthExceeds alts 1)"
461                 -- condition above, but without that some programs got worse
462                 -- (spectral/hartel/event and spectral/para).  I don't fully
463                 -- understand why. (SDM 24/5/11)
464
465                 -- unboxed variables, inline primops and unsafe foreign calls
466                 -- are all "inline" things:
467           is_inline_scrut (Var v) = isUnLiftedType (idType v)
468           is_inline_scrut scrut
469               | (Var f, _) <- collectArgs scrut
470                 = case idDetails f of
471                     FCallId fc  -> not (isSafeForeignCall fc)
472                     PrimOpId op -> not (primOpOutOfLine op)
473                     _other      -> False
474               | otherwise
475                 = False
476
477     ------------ 
478     -- size_up_app is used when there's ONE OR MORE value args
479     size_up_app (App fun arg) args 
480         | isTyCoArg arg            = size_up_app fun args
481         | otherwise                = size_up arg  `addSizeNSD`
482                                      size_up_app fun (arg:args)
483     size_up_app (Var fun)     args = size_up_call fun args
484     size_up_app other         args = size_up other `addSizeN` length args
485
486     ------------ 
487     size_up_call :: Id -> [CoreExpr] -> ExprSize
488     size_up_call fun val_args
489        = case idDetails fun of
490            FCallId _        -> sizeN (10 * (1 + length val_args))
491            DataConWorkId dc -> conSize    dc (length val_args)
492            PrimOpId op      -> primOpSize op (length val_args)
493            ClassOpId _      -> classOpSize top_args val_args
494            _                -> funSize top_args fun (length val_args)
495
496     ------------ 
497     size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 10
498         -- Don't charge for args, so that wrappers look cheap
499         -- (See comments about wrappers with Case)
500         --
501         -- IMPORATANT: *do* charge 1 for the alternative, else we 
502         -- find that giant case nests are treated as practically free
503         -- A good example is Foreign.C.Error.errrnoToIOError
504
505     ------------
506         -- These addSize things have to be here because
507         -- I don't want to give them bOMB_OUT_SIZE as an argument
508     addSizeN TooBig          _  = TooBig
509     addSizeN (SizeIs n xs d) m  = mkSizeIs bOMB_OUT_SIZE (n +# iUnbox m) xs d
510     
511         -- addAltSize is used to add the sizes of case alternatives
512     addAltSize TooBig            _      = TooBig
513     addAltSize _                 TooBig = TooBig
514     addAltSize (SizeIs n1 xs d1) (SizeIs n2 ys d2) 
515         = mkSizeIs bOMB_OUT_SIZE (n1 +# n2) 
516                                  (xs `unionBags` ys) 
517                                  (d1 +# d2)   -- Note [addAltSize result discounts]
518
519         -- This variant ignores the result discount from its LEFT argument
520         -- It's used when the second argument isn't part of the result
521     addSizeNSD TooBig            _      = TooBig
522     addSizeNSD _                 TooBig = TooBig
523     addSizeNSD (SizeIs n1 xs _) (SizeIs n2 ys d2) 
524         = mkSizeIs bOMB_OUT_SIZE (n1 +# n2) 
525                                  (xs `unionBags` ys) 
526                                  d2  -- Ignore d1
527 \end{code}
528
529
530 \begin{code}
531 -- | Finds a nominal size of a string literal.
532 litSize :: Literal -> Int
533 -- Used by CoreUnfold.sizeExpr
534 litSize (LitInteger {}) = 100   -- Note [Size of literal integers]
535 litSize (MachStr str)   = 10 + 10 * ((lengthFS str + 3) `div` 4)
536         -- If size could be 0 then @f "x"@ might be too small
537         -- [Sept03: make literal strings a bit bigger to avoid fruitless 
538         --  duplication of little strings]
539 litSize _other = 0    -- Must match size of nullary constructors
540                       -- Key point: if  x |-> 4, then x must inline unconditionally
541                       --            (eg via case binding)
542
543 classOpSize :: [Id] -> [CoreExpr] -> ExprSize
544 -- See Note [Conlike is interesting]
545 classOpSize _ [] 
546   = sizeZero
547 classOpSize top_args (arg1 : other_args)
548   = SizeIs (iUnbox size) arg_discount (_ILIT(0))
549   where
550     size = 20 + (10 * length other_args)
551     -- If the class op is scrutinising a lambda bound dictionary then
552     -- give it a discount, to encourage the inlining of this function
553     -- The actual discount is rather arbitrarily chosen
554     arg_discount = case arg1 of
555                      Var dict | dict `elem` top_args 
556                               -> unitBag (dict, opt_UF_DictDiscount)
557                      _other   -> emptyBag
558                      
559 funSize :: [Id] -> Id -> Int -> ExprSize
560 -- Size for functions that are not constructors or primops
561 -- Note [Function applications]
562 funSize top_args fun n_val_args
563   | fun `hasKey` buildIdKey   = buildSize
564   | fun `hasKey` augmentIdKey = augmentSize
565   | otherwise = SizeIs (iUnbox size) arg_discount (iUnbox res_discount)
566   where
567     some_val_args = n_val_args > 0
568
569     size | some_val_args = 10 * (1 + n_val_args)
570          | otherwise     = 0
571         -- The 1+ is for the function itself
572         -- Add 1 for each non-trivial arg;
573         -- the allocation cost, as in let(rec)
574   
575         --                  DISCOUNTS
576         --  See Note [Function and non-function discounts]
577     arg_discount | some_val_args && fun `elem` top_args
578                  = unitBag (fun, opt_UF_FunAppDiscount)
579                  | otherwise = emptyBag
580         -- If the function is an argument and is applied
581         -- to some values, give it an arg-discount
582
583     res_discount | idArity fun > n_val_args = opt_UF_FunAppDiscount
584                  | otherwise                = 0
585         -- If the function is partially applied, show a result discount
586
587 conSize :: DataCon -> Int -> ExprSize
588 conSize dc n_val_args
589   | n_val_args == 0 = SizeIs (_ILIT(0)) emptyBag (_ILIT(10))    -- Like variables
590
591 -- See Note [Unboxed tuple size and result discount]
592   | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (iUnbox (10 * (1 + n_val_args)))
593
594 -- See Note [Constructor size and result discount]
595   | otherwise = SizeIs (_ILIT(10)) emptyBag (iUnbox (10 * (1 + n_val_args)))
596 \end{code}
597
598 Note [Constructor size and result discount]
599 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
600 Treat a constructors application as size 10, regardless of how many
601 arguments it has; we are keen to expose them (and we charge separately
602 for their args).  We can't treat them as size zero, else we find that
603 (Just x) has size 0, which is the same as a lone variable; and hence
604 'v' will always be replaced by (Just x), where v is bound to Just x.
605
606 The "result discount" is applied if the result of the call is
607 scrutinised (say by a case).  For a constructor application that will
608 mean the constructor application will disappear, so we don't need to
609 charge it to the function.  So the discount should at least match the
610 cost of the constructor application, namely 10.  But to give a bit
611 of extra incentive we give a discount of 10*(1 + n_val_args).
612
613 Simon M tried a MUCH bigger discount: (10 * (10 + n_val_args)), 
614 and said it was an "unambiguous win", but its terribly dangerous
615 because a fuction with many many case branches, each finishing with
616 a constructor, can have an arbitrarily large discount.  This led to
617 terrible code bloat: see Trac #6099.
618
619 Note [Unboxed tuple size and result discount]
620 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
621 However, unboxed tuples count as size zero. I found occasions where we had 
622         f x y z = case op# x y z of { s -> (# s, () #) }
623 and f wasn't getting inlined.
624
625 I tried giving unboxed tuples a *result discount* of zero (see the
626 commented-out line).  Why?  When returned as a result they do not
627 allocate, so maybe we don't want to charge so much for them If you
628 have a non-zero discount here, we find that workers often get inlined
629 back into wrappers, because it look like
630     f x = case $wf x of (# a,b #) -> (a,b)
631 and we are keener because of the case.  However while this change
632 shrank binary sizes by 0.5% it also made spectral/boyer allocate 5%
633 more. All other changes were very small. So it's not a big deal but I
634 didn't adopt the idea.
635
636 Note [Function and non-function discounts]
637 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
638 We want a discount if the function is applied. A good example is
639 monadic combinators with continuation arguments, where inlining is
640 quite important.
641
642 But we don't want a big discount when a function is called many times
643 (see the detailed comments with Trac #6048) because if the function is 
644 big it won't be inlined at its many call sites and no benefit results.
645 Indeed, we can get exponentially big inlinings this way; that is what
646 Trac #6048 is about.
647
648 On the other hand, for data-valued arguments, if there are lots of
649 case expressions in the body, each one will get smaller if we apply
650 the function to a constructor application, so we *want* a big discount
651 if the argument is scrutinised by many case expressions.
652
653 Conclusion:
654   - For functions, take the max of the discounts
655   - For data values, take the sum of the discounts
656
657
658 Note [Literal integer size]
659 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
660 Literal integers *can* be big (mkInteger [...coefficients...]), but
661 need not be (S# n).  We just use an aribitrary big-ish constant here
662 so that, in particular, we don't inline top-level defns like
663    n = S# 5
664 There's no point in doing so -- any optimsations will see the S#
665 through n's unfolding.  Nor will a big size inhibit unfoldings functions
666 that mention a literal Integer, because the float-out pass will float
667 all those constants to top level.
668
669 \begin{code}
670 primOpSize :: PrimOp -> Int -> ExprSize
671 primOpSize op n_val_args
672  = if primOpOutOfLine op
673       then sizeN (op_size + n_val_args)
674       else sizeN op_size
675  where
676    op_size = primOpCodeSize op
677
678
679 buildSize :: ExprSize
680 buildSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(40))
681         -- We really want to inline applications of build
682         -- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
683         -- Indeed, we should add a result_discount becuause build is 
684         -- very like a constructor.  We don't bother to check that the
685         -- build is saturated (it usually is).  The "-2" discounts for the \c n, 
686         -- The "4" is rather arbitrary.
687
688 augmentSize :: ExprSize
689 augmentSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(40))
690         -- Ditto (augment t (\cn -> e) ys) should cost only the cost of
691         -- e plus ys. The -2 accounts for the \cn 
692
693 -- When we return a lambda, give a discount if it's used (applied)
694 lamScrutDiscount :: ExprSize -> ExprSize
695 lamScrutDiscount (SizeIs n vs _) = SizeIs n vs (iUnbox opt_UF_FunAppDiscount)
696 lamScrutDiscount TooBig          = TooBig
697 \end{code}
698
699 Note [addAltSize result discounts]
700 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
701 When adding the size of alternatives, we *add* the result discounts
702 too, rather than take the *maximum*.  For a multi-branch case, this
703 gives a discount for each branch that returns a constructor, making us
704 keener to inline.  I did try using 'max' instead, but it makes nofib 
705 'rewrite' and 'puzzle' allocate significantly more, and didn't make
706 binary sizes shrink significantly either.
707
708 Note [Discounts and thresholds]
709 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
710 Constants for discounts and thesholds are defined in main/StaticFlags,
711 all of form opt_UF_xxxx.   They are:
712
713 opt_UF_CreationThreshold (45)
714      At a definition site, if the unfolding is bigger than this, we
715      may discard it altogether
716
717 opt_UF_UseThreshold (6)
718      At a call site, if the unfolding, less discounts, is smaller than
719      this, then it's small enough inline
720
721 opt_UF_KeennessFactor (1.5)
722      Factor by which the discounts are multiplied before 
723      subtracting from size
724
725 opt_UF_DictDiscount (1)
726      The discount for each occurrence of a dictionary argument
727      as an argument of a class method.  Should be pretty small
728      else big functions may get inlined
729
730 opt_UF_FunAppDiscount (6)
731      Discount for a function argument that is applied.  Quite
732      large, because if we inline we avoid the higher-order call.
733
734 opt_UF_DearOp (4)
735      The size of a foreign call or not-dupable PrimOp
736
737
738 Note [Function applications]
739 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
740 In a function application (f a b)
741
742   - If 'f' is an argument to the function being analysed, 
743     and there's at least one value arg, record a FunAppDiscount for f
744
745   - If the application if a PAP (arity > 2 in this example)
746     record a *result* discount (because inlining
747     with "extra" args in the call may mean that we now 
748     get a saturated application)
749
750 Code for manipulating sizes
751
752 \begin{code}
753 data ExprSize = TooBig
754               | SizeIs FastInt          -- Size found
755                        (Bag (Id,Int))   -- Arguments cased herein, and discount for each such
756                        FastInt          -- Size to subtract if result is scrutinised 
757                                         -- by a case expression
758
759 instance Outputable ExprSize where
760   ppr TooBig         = ptext (sLit "TooBig")
761   ppr (SizeIs a _ c) = brackets (int (iBox a) <+> int (iBox c))
762
763 -- subtract the discount before deciding whether to bale out. eg. we
764 -- want to inline a large constructor application into a selector:
765 --      tup = (a_1, ..., a_99)
766 --      x = case tup of ...
767 --
768 mkSizeIs :: FastInt -> FastInt -> Bag (Id, Int) -> FastInt -> ExprSize
769 mkSizeIs max n xs d | (n -# d) ># max = TooBig
770                     | otherwise       = SizeIs n xs d
771  
772 maxSize :: ExprSize -> ExprSize -> ExprSize
773 maxSize TooBig         _                                  = TooBig
774 maxSize _              TooBig                             = TooBig
775 maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 ># n2  = s1
776                                               | otherwise = s2
777
778 sizeZero :: ExprSize
779 sizeN :: Int -> ExprSize
780
781 sizeZero = SizeIs (_ILIT(0))  emptyBag (_ILIT(0))
782 sizeN n  = SizeIs (iUnbox n) emptyBag (_ILIT(0))
783 \end{code}
784
785
786 %************************************************************************
787 %*                                                                      *
788 \subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}
789 %*                                                                      *
790 %************************************************************************
791
792 We use 'couldBeSmallEnoughToInline' to avoid exporting inlinings that
793 we ``couldn't possibly use'' on the other side.  Can be overridden w/
794 flaggery.  Just the same as smallEnoughToInline, except that it has no
795 actual arguments.
796
797 \begin{code}
798 couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
799 couldBeSmallEnoughToInline threshold rhs 
800   = case sizeExpr (iUnbox threshold) [] body of
801        TooBig -> False
802        _      -> True
803   where
804     (_, body) = collectBinders rhs
805
806 ----------------
807 smallEnoughToInline :: Unfolding -> Bool
808 smallEnoughToInline (CoreUnfolding {uf_guidance = UnfIfGoodArgs {ug_size = size}})
809   = size <= opt_UF_UseThreshold
810 smallEnoughToInline _
811   = False
812
813 ----------------
814 certainlyWillInline :: Unfolding -> Bool
815   -- Sees if the unfolding is pretty certain to inline  
816 certainlyWillInline (CoreUnfolding { uf_arity = n_vals, uf_guidance = guidance })
817   = case guidance of
818       UnfNever      -> False
819       UnfWhen {}    -> True
820       UnfIfGoodArgs { ug_size = size} 
821                     -> n_vals > 0     -- See Note [certainlyWillInline: be caseful of thunks]
822                     && size - (10 * (n_vals +1)) <= opt_UF_UseThreshold
823
824 certainlyWillInline _
825   = False
826 \end{code}
827
828 Note [certainlyWillInline: be caseful of thunks]
829 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
830 Don't claim that thunks will certainly inline, because that risks work
831 duplication.  Even if the work duplication is not great (eg is_cheap
832 holds), it can make a big difference in an inner loop In Trac #5623 we
833 found that the WorkWrap phase thought that
834        y = case x of F# v -> F# (v +# v)
835 was certainlyWillInline, so the addition got duplicated.  
836
837
838 %************************************************************************
839 %*                                                                      *
840 \subsection{callSiteInline}
841 %*                                                                      *
842 %************************************************************************
843
844 This is the key function.  It decides whether to inline a variable at a call site
845
846 callSiteInline is used at call sites, so it is a bit more generous.
847 It's a very important function that embodies lots of heuristics.
848 A non-WHNF can be inlined if it doesn't occur inside a lambda,
849 and occurs exactly once or 
850     occurs once in each branch of a case and is small
851
852 If the thing is in WHNF, there's no danger of duplicating work, 
853 so we can inline if it occurs once, or is small
854
855 NOTE: we don't want to inline top-level functions that always diverge.
856 It just makes the code bigger.  Tt turns out that the convenient way to prevent
857 them inlining is to give them a NOINLINE pragma, which we do in 
858 StrictAnal.addStrictnessInfoToTopId
859
860 \begin{code}
861 callSiteInline :: DynFlags
862                -> Id                    -- The Id
863                -> Bool                  -- True <=> unfolding is active
864                -> Bool                  -- True if there are are no arguments at all (incl type args)
865                -> [ArgSummary]          -- One for each value arg; True if it is interesting
866                -> CallCtxt              -- True <=> continuation is interesting
867                -> Maybe CoreExpr        -- Unfolding, if any
868
869 instance Outputable ArgSummary where
870   ppr TrivArg    = ptext (sLit "TrivArg")
871   ppr NonTrivArg = ptext (sLit "NonTrivArg")
872   ppr ValueArg   = ptext (sLit "ValueArg")
873
874 data CallCtxt = BoringCtxt
875
876               | ArgCtxt         -- We are somewhere in the argument of a function
877                         Bool    -- True  <=> we're somewhere in the RHS of function with rules
878                                 -- False <=> we *are* the argument of a function with non-zero
879                                 --           arg discount
880                                 --        OR 
881                                 --           we *are* the RHS of a let  Note [RHS of lets]
882                                 -- In both cases, be a little keener to inline
883
884               | ValAppCtxt      -- We're applied to at least one value arg
885                                 -- This arises when we have ((f x |> co) y)
886                                 -- Then the (f x) has argument 'x' but in a ValAppCtxt
887
888               | CaseCtxt        -- We're the scrutinee of a case
889                                 -- that decomposes its scrutinee
890
891 instance Outputable CallCtxt where
892   ppr BoringCtxt      = ptext (sLit "BoringCtxt")
893   ppr (ArgCtxt rules) = ptext (sLit "ArgCtxt") <+> ppr rules
894   ppr CaseCtxt        = ptext (sLit "CaseCtxt")
895   ppr ValAppCtxt      = ptext (sLit "ValAppCtxt")
896
897 callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info
898   = case idUnfolding id of 
899       -- idUnfolding checks for loop-breakers, returning NoUnfolding
900       -- Things with an INLINE pragma may have an unfolding *and* 
901       -- be a loop breaker  (maybe the knot is not yet untied)
902         CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top 
903                       , uf_is_work_free = is_wf, uf_arity = uf_arity
904                       , uf_guidance = guidance, uf_expandable = is_exp }
905           | active_unfolding -> tryUnfolding dflags id lone_variable 
906                                     arg_infos cont_info unf_template is_top 
907                                     is_wf is_exp uf_arity guidance
908           | dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags
909           -> pprTrace "Inactive unfolding:" (ppr id) Nothing
910           | otherwise -> Nothing
911         NoUnfolding      -> Nothing 
912         OtherCon {}      -> Nothing 
913         DFunUnfolding {} -> Nothing     -- Never unfold a DFun
914
915 tryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt
916              -> CoreExpr -> Bool -> Bool -> Bool -> Arity -> UnfoldingGuidance
917              -> Maybe CoreExpr  
918 tryUnfolding dflags id lone_variable 
919              arg_infos cont_info unf_template is_top 
920              is_wf is_exp uf_arity guidance
921                         -- uf_arity will typically be equal to (idArity id), 
922                         -- but may be less for InlineRules
923  | dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags
924  = pprTrace ("Considering inlining: " ++ showSDocDump dflags (ppr id))
925                  (vcat [text "arg infos" <+> ppr arg_infos,
926                         text "uf arity" <+> ppr uf_arity,
927                         text "interesting continuation" <+> ppr cont_info,
928                         text "some_benefit" <+> ppr some_benefit,
929                         text "is exp:" <+> ppr is_exp,
930                         text "is work-free:" <+> ppr is_wf,
931                         text "guidance" <+> ppr guidance,
932                         extra_doc,
933                         text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
934                  result
935   | otherwise  = result
936
937   where
938     n_val_args = length arg_infos
939     saturated  = n_val_args >= uf_arity
940
941     result | yes_or_no = Just unf_template
942            | otherwise = Nothing
943
944     interesting_args = any nonTriv arg_infos 
945         -- NB: (any nonTriv arg_infos) looks at the
946         -- over-saturated args too which is "wrong"; 
947         -- but if over-saturated we inline anyway.
948
949            -- some_benefit is used when the RHS is small enough
950            -- and the call has enough (or too many) value
951            -- arguments (ie n_val_args >= arity). But there must
952            -- be *something* interesting about some argument, or the
953            -- result context, to make it worth inlining
954     some_benefit 
955        | not saturated = interesting_args       -- Under-saturated
956                                         -- Note [Unsaturated applications]
957        | n_val_args > uf_arity = True   -- Over-saturated
958        | otherwise = interesting_args   -- Saturated
959                   || interesting_saturated_call 
960
961     interesting_saturated_call 
962       = case cont_info of
963           BoringCtxt -> not is_top && uf_arity > 0        -- Note [Nested functions]
964           CaseCtxt   -> not (lone_variable && is_wf)      -- Note [Lone variables]
965           ArgCtxt {} -> uf_arity > 0                      -- Note [Inlining in ArgCtxt]
966           ValAppCtxt -> True                              -- Note [Cast then apply]
967
968     (yes_or_no, extra_doc)
969       = case guidance of
970           UnfNever -> (False, empty)
971
972           UnfWhen unsat_ok boring_ok 
973              -> (enough_args && (boring_ok || some_benefit), empty )
974              where      -- See Note [INLINE for small functions (3)]
975                enough_args = saturated || (unsat_ok && n_val_args > 0)
976
977           UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
978              -> ( is_wf && some_benefit && small_enough
979                 , (text "discounted size =" <+> int discounted_size) )
980              where
981                discounted_size = size - discount
982                small_enough = discounted_size <= opt_UF_UseThreshold
983                discount = computeDiscount uf_arity arg_discounts 
984                                           res_discount arg_infos cont_info
985 \end{code}
986
987 Note [RHS of lets]
988 ~~~~~~~~~~~~~~~~~~
989 Be a tiny bit keener to inline in the RHS of a let, because that might
990 lead to good thing later
991      f y = (y,y,y)
992      g y = let x = f y in ...(case x of (a,b,c) -> ...) ...
993 We'd inline 'f' if the call was in a case context, and it kind-of-is,
994 only we can't see it.  So we treat the RHS of a let as not-totally-boring.
995     
996 Note [Unsaturated applications]
997 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
998 When a call is not saturated, we *still* inline if one of the
999 arguments has interesting structure.  That's sometimes very important.
1000 A good example is the Ord instance for Bool in Base:
1001
1002  Rec {
1003     $fOrdBool =GHC.Classes.D:Ord
1004                  @ Bool
1005                  ...
1006                  $cmin_ajX
1007
1008     $cmin_ajX [Occ=LoopBreaker] :: Bool -> Bool -> Bool
1009     $cmin_ajX = GHC.Classes.$dmmin @ Bool $fOrdBool
1010   }
1011
1012 But the defn of GHC.Classes.$dmmin is:
1013
1014   $dmmin :: forall a. GHC.Classes.Ord a => a -> a -> a
1015     {- Arity: 3, HasNoCafRefs, Strictness: SLL,
1016        Unfolding: (\ @ a $dOrd :: GHC.Classes.Ord a x :: a y :: a ->
1017                    case @ a GHC.Classes.<= @ a $dOrd x y of wild {
1018                      GHC.Types.False -> y GHC.Types.True -> x }) -}
1019
1020 We *really* want to inline $dmmin, even though it has arity 3, in
1021 order to unravel the recursion.
1022
1023
1024 Note [Things to watch]
1025 ~~~~~~~~~~~~~~~~~~~~~~
1026 *   { y = I# 3; x = y `cast` co; ...case (x `cast` co) of ... }
1027     Assume x is exported, so not inlined unconditionally.
1028     Then we want x to inline unconditionally; no reason for it 
1029     not to, and doing so avoids an indirection.
1030
1031 *   { x = I# 3; ....f x.... }
1032     Make sure that x does not inline unconditionally!  
1033     Lest we get extra allocation.
1034
1035 Note [Inlining an InlineRule]
1036 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1037 An InlineRules is used for
1038   (a) programmer INLINE pragmas
1039   (b) inlinings from worker/wrapper
1040
1041 For (a) the RHS may be large, and our contract is that we *only* inline
1042 when the function is applied to all the arguments on the LHS of the
1043 source-code defn.  (The uf_arity in the rule.)
1044
1045 However for worker/wrapper it may be worth inlining even if the 
1046 arity is not satisfied (as we do in the CoreUnfolding case) so we don't
1047 require saturation.
1048
1049
1050 Note [Nested functions]
1051 ~~~~~~~~~~~~~~~~~~~~~~~
1052 If a function has a nested defn we also record some-benefit, on the
1053 grounds that we are often able to eliminate the binding, and hence the
1054 allocation, for the function altogether; this is good for join points.
1055 But this only makes sense for *functions*; inlining a constructor
1056 doesn't help allocation unless the result is scrutinised.  UNLESS the
1057 constructor occurs just once, albeit possibly in multiple case
1058 branches.  Then inlining it doesn't increase allocation, but it does
1059 increase the chance that the constructor won't be allocated at all in
1060 the branches that don't use it.
1061
1062 Note [Cast then apply]
1063 ~~~~~~~~~~~~~~~~~~~~~~
1064 Consider
1065    myIndex = __inline_me ( (/\a. <blah>) |> co )
1066    co :: (forall a. a -> a) ~ (forall a. T a)
1067      ... /\a.\x. case ((myIndex a) |> sym co) x of { ... } ...
1068
1069 We need to inline myIndex to unravel this; but the actual call (myIndex a) has
1070 no value arguments.  The ValAppCtxt gives it enough incentive to inline.
1071
1072 Note [Inlining in ArgCtxt]
1073 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1074 The condition (arity > 0) here is very important, because otherwise
1075 we end up inlining top-level stuff into useless places; eg
1076    x = I# 3#
1077    f = \y.  g x
1078 This can make a very big difference: it adds 16% to nofib 'integer' allocs,
1079 and 20% to 'power'.
1080
1081 At one stage I replaced this condition by 'True' (leading to the above 
1082 slow-down).  The motivation was test eyeball/inline1.hs; but that seems
1083 to work ok now.
1084
1085 NOTE: arguably, we should inline in ArgCtxt only if the result of the
1086 call is at least CONLIKE.  At least for the cases where we use ArgCtxt
1087 for the RHS of a 'let', we only profit from the inlining if we get a 
1088 CONLIKE thing (modulo lets).
1089
1090 Note [Lone variables]   See also Note [Interaction of exprIsWorkFree and lone variables]
1091 ~~~~~~~~~~~~~~~~~~~~~   which appears below
1092 The "lone-variable" case is important.  I spent ages messing about
1093 with unsatisfactory varaints, but this is nice.  The idea is that if a
1094 variable appears all alone
1095
1096         as an arg of lazy fn, or rhs    BoringCtxt
1097         as scrutinee of a case          CaseCtxt
1098         as arg of a fn                  ArgCtxt
1099 AND
1100         it is bound to a cheap expression
1101
1102 then we should not inline it (unless there is some other reason,
1103 e.g. is is the sole occurrence).  That is what is happening at 
1104 the use of 'lone_variable' in 'interesting_saturated_call'.
1105
1106 Why?  At least in the case-scrutinee situation, turning
1107         let x = (a,b) in case x of y -> ...
1108 into
1109         let x = (a,b) in case (a,b) of y -> ...
1110 and thence to 
1111         let x = (a,b) in let y = (a,b) in ...
1112 is bad if the binding for x will remain.
1113
1114 Another example: I discovered that strings
1115 were getting inlined straight back into applications of 'error'
1116 because the latter is strict.
1117         s = "foo"
1118         f = \x -> ...(error s)...
1119
1120 Fundamentally such contexts should not encourage inlining because the
1121 context can ``see'' the unfolding of the variable (e.g. case or a
1122 RULE) so there's no gain.  If the thing is bound to a value.
1123
1124 However, watch out:
1125
1126  * Consider this:
1127         foo = _inline_ (\n. [n])
1128         bar = _inline_ (foo 20)
1129         baz = \n. case bar of { (m:_) -> m + n }
1130    Here we really want to inline 'bar' so that we can inline 'foo'
1131    and the whole thing unravels as it should obviously do.  This is 
1132    important: in the NDP project, 'bar' generates a closure data
1133    structure rather than a list. 
1134
1135    So the non-inlining of lone_variables should only apply if the
1136    unfolding is regarded as cheap; because that is when exprIsConApp_maybe
1137    looks through the unfolding.  Hence the "&& is_wf" in the
1138    InlineRule branch.
1139
1140  * Even a type application or coercion isn't a lone variable.
1141    Consider
1142         case $fMonadST @ RealWorld of { :DMonad a b c -> c }
1143    We had better inline that sucker!  The case won't see through it.
1144
1145    For now, I'm treating treating a variable applied to types 
1146    in a *lazy* context "lone". The motivating example was
1147         f = /\a. \x. BIG
1148         g = /\a. \y.  h (f a)
1149    There's no advantage in inlining f here, and perhaps
1150    a significant disadvantage.  Hence some_val_args in the Stop case
1151
1152 Note [Interaction of exprIsWorkFree and lone variables]
1153 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1154 The lone-variable test says "don't inline if a case expression
1155 scrutines a lone variable whose unfolding is cheap".  It's very 
1156 important that, under these circumstances, exprIsConApp_maybe
1157 can spot a constructor application. So, for example, we don't
1158 consider
1159         let x = e in (x,x)
1160 to be cheap, and that's good because exprIsConApp_maybe doesn't
1161 think that expression is a constructor application.
1162
1163 In the 'not (lone_variable && is_wf)' test, I used to test is_value
1164 rather than is_wf, which was utterly wrong, because the above
1165 expression responds True to exprIsHNF, which is what sets is_value.
1166
1167 This kind of thing can occur if you have
1168
1169         {-# INLINE foo #-}
1170         foo = let x = e in (x,x)
1171
1172 which Roman did.
1173
1174 \begin{code}
1175 computeDiscount :: Int -> [Int] -> Int -> [ArgSummary] -> CallCtxt -> Int
1176 computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info
1177         -- We multiple the raw discounts (args_discount and result_discount)
1178         -- ty opt_UnfoldingKeenessFactor because the former have to do with
1179         --  *size* whereas the discounts imply that there's some extra 
1180         --  *efficiency* to be gained (e.g. beta reductions, case reductions) 
1181         -- by inlining.
1182
1183   = 10          -- Discount of 1 because the result replaces the call
1184                 -- so we count 1 for the function itself
1185
1186     + 10 * length (take n_vals_wanted arg_infos)
1187                -- Discount of (un-scaled) 1 for each arg supplied, 
1188                -- because the result replaces the call
1189
1190     + round (opt_UF_KeenessFactor * 
1191              fromIntegral (arg_discount + res_discount'))
1192   where
1193     arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)
1194
1195     mk_arg_discount _        TrivArg    = 0 
1196     mk_arg_discount _        NonTrivArg = 10
1197     mk_arg_discount discount ValueArg   = discount 
1198
1199     res_discount' = case cont_info of
1200                         BoringCtxt  -> 0
1201                         CaseCtxt    -> res_discount
1202                         _other      -> 40 `min` res_discount
1203                 -- res_discount can be very large when a function returns
1204                 -- constructors; but we only want to invoke that large discount
1205                 -- when there's a case continuation.
1206                 -- Otherwise we, rather arbitrarily, threshold it.  Yuk.
1207                 -- But we want to aovid inlining large functions that return 
1208                 -- constructors into contexts that are simply "interesting"
1209 \end{code}
1210
1211 %************************************************************************
1212 %*                                                                      *
1213         Interesting arguments
1214 %*                                                                      *
1215 %************************************************************************
1216
1217 Note [Interesting arguments]
1218 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1219 An argument is interesting if it deserves a discount for unfoldings
1220 with a discount in that argument position.  The idea is to avoid
1221 unfolding a function that is applied only to variables that have no
1222 unfolding (i.e. they are probably lambda bound): f x y z There is
1223 little point in inlining f here.
1224
1225 Generally, *values* (like (C a b) and (\x.e)) deserve discounts.  But
1226 we must look through lets, eg (let x = e in C a b), because the let will
1227 float, exposing the value, if we inline.  That makes it different to
1228 exprIsHNF.
1229
1230 Before 2009 we said it was interesting if the argument had *any* structure
1231 at all; i.e. (hasSomeUnfolding v).  But does too much inlining; see Trac #3016.
1232
1233 But we don't regard (f x y) as interesting, unless f is unsaturated.
1234 If it's saturated and f hasn't inlined, then it's probably not going
1235 to now!
1236
1237 Note [Conlike is interesting]
1238 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1239 Consider
1240         f d = ...((*) d x y)...
1241         ... f (df d')...
1242 where df is con-like. Then we'd really like to inline 'f' so that the
1243 rule for (*) (df d) can fire.  To do this 
1244   a) we give a discount for being an argument of a class-op (eg (*) d)
1245   b) we say that a con-like argument (eg (df d)) is interesting
1246
1247 \begin{code}
1248 data ArgSummary = TrivArg       -- Nothing interesting
1249                 | NonTrivArg    -- Arg has structure
1250                 | ValueArg      -- Arg is a con-app or PAP
1251                                 -- ..or con-like. Note [Conlike is interesting]
1252
1253 interestingArg :: CoreExpr -> ArgSummary
1254 -- See Note [Interesting arguments]
1255 interestingArg e = go e 0
1256   where
1257     -- n is # value args to which the expression is applied
1258     go (Lit {}) _          = ValueArg
1259     go (Var v)  n
1260        | isConLikeId v     = ValueArg   -- Experimenting with 'conlike' rather that
1261                                         --    data constructors here
1262        | idArity v > n     = ValueArg   -- Catches (eg) primops with arity but no unfolding
1263        | n > 0             = NonTrivArg -- Saturated or unknown call
1264        | conlike_unfolding = ValueArg   -- n==0; look for an interesting unfolding
1265                                         -- See Note [Conlike is interesting]
1266        | otherwise         = TrivArg    -- n==0, no useful unfolding
1267        where
1268          conlike_unfolding = isConLikeUnfolding (idUnfolding v)
1269
1270     go (Type _)          _ = TrivArg
1271     go (Coercion _)      _ = TrivArg
1272     go (App fn (Type _)) n = go fn n
1273     go (App fn (Coercion _)) n = go fn n
1274     go (App fn _)        n = go fn (n+1)
1275     go (Tick _ a)      n = go a n
1276     go (Cast e _)        n = go e n
1277     go (Lam v e)         n 
1278        | isTyVar v         = go e n
1279        | n>0               = go e (n-1)
1280        | otherwise         = ValueArg
1281     go (Let _ e)         n = case go e n of { ValueArg -> ValueArg; _ -> NonTrivArg }
1282     go (Case {})         _ = NonTrivArg
1283
1284 nonTriv ::  ArgSummary -> Bool
1285 nonTriv TrivArg = False
1286 nonTriv _       = True
1287 \end{code}