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 module CoreUnfold (
  19         Unfolding, UnfoldingGuidance,   -- Abstract types
  20
  21         noUnfolding, mkTopUnfolding, mkUnfolding, mkCompulsoryUnfolding, seqUnfolding,
  22         evaldUnfolding, mkOtherCon, otherCons,
  23         unfoldingTemplate, maybeUnfoldingTemplate,
  24         isEvaldUnfolding, isValueUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
  25         hasUnfolding, hasSomeUnfolding, neverUnfold,
  26
  27         couldBeSmallEnoughToInline,
  28         certainlyWillInline, smallEnoughToInline,
  29
  30         callSiteInline, CallContInfo(..)
  31
  32     ) where
  33
  34 #include "HsVersions.h"
  35
  36 import StaticFlags
  37 import DynFlags
  38 import CoreSyn
  39 import PprCore          ()      -- Instances
  40 import OccurAnal
  41 import CoreUtils
  42 import Id
  43 import DataCon
  44 import Literal
  45 import PrimOp
  46 import IdInfo
  47 import Type
  48 import PrelNames
  49 import Bag
  50 import FastTypes
  51 import Outputable
  52
  53 \end{code}
  54
  55
  56 %************************************************************************
  57 %*                                                                      *
  58 \subsection{Making unfoldings}
  59 %*                                                                      *
  60 %************************************************************************
  61
  62 \begin{code}
  63 mkTopUnfolding :: CoreExpr -> Unfolding
  64 mkTopUnfolding expr = mkUnfolding True {- Top level -} expr
  65
  66 mkUnfolding :: Bool -> CoreExpr -> Unfolding
  67 mkUnfolding top_lvl expr
  68   = CoreUnfolding (occurAnalyseExpr expr)
  69                   top_lvl
  70
  71                   (exprIsHNF expr)
  72                         -- Already evaluated
  73
  74                   (exprIsCheap expr)
  75                         -- OK to inline inside a lambda
  76
  77                   (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
  78         -- Sometimes during simplification, there's a large let-bound thing
  79         -- which has been substituted, and so is now dead; so 'expr' contains
  80         -- two copies of the thing while the occurrence-analysed expression doesn't
  81         -- Nevertheless, we don't occ-analyse before computing the size because the
  82         -- size computation bales out after a while, whereas occurrence analysis does not.
  83         --
  84         -- This can occasionally mean that the guidance is very pessimistic;
  85         -- it gets fixed up next round
  86
  87 instance Outputable Unfolding where
  88   ppr NoUnfolding = ptext SLIT("No unfolding")
  89   ppr (OtherCon cs) = ptext SLIT("OtherCon") <+> ppr cs
  90   ppr (CompulsoryUnfolding e) = ptext SLIT("Compulsory") <+> ppr e
  91   ppr (CoreUnfolding e top hnf cheap g)
  92         = ptext SLIT("Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g,
  93                                      ppr e]
  94
  95 mkCompulsoryUnfolding :: CoreExpr -> Unfolding
  96 mkCompulsoryUnfolding expr      -- Used for things that absolutely must be unfolded
  97   = CompulsoryUnfolding (occurAnalyseExpr expr)
  98 \end{code}
  99
 100
 101 %************************************************************************
 102 %*                                                                      *
 103 \subsection{The UnfoldingGuidance type}
 104 %*                                                                      *
 105 %************************************************************************
 106
 107 \begin{code}
 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)),
 113                int size,
 114                int discount ]
 115 \end{code}
 116
 117
 118 \begin{code}
 119 calcUnfoldingGuidance
 120         :: Int                  -- bomb out if size gets bigger than this
 121         -> CoreExpr             -- expression to look at
 122         -> UnfoldingGuidance
 123 calcUnfoldingGuidance bOMB_OUT_SIZE expr
 124   = case collect_val_bndrs expr of { (inline, val_binders, body) ->
 125     let
 126         n_val_binders = length val_binders
 127
 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,
 133         --   but no more.
 134
 135     in
 136     case (sizeExpr (iUnbox bOMB_OUT_SIZE) val_binders body) of
 137
 138       TooBig
 139         | not inline -> UnfoldNever
 140                 -- A big function with an INLINE pragma must
 141                 -- have an UnfoldIfGoodArgs guidance
 142         | otherwise  -> UnfoldIfGoodArgs n_val_binders
 143                                          (map (const 0) val_binders)
 144                                          max_inline_size 0
 145
 146       SizeIs size cased_args scrut_discount
 147         -> UnfoldIfGoodArgs
 148                         n_val_binders
 149                         (map discount_for val_binders)
 150                         final_size
 151                         (iBox scrut_discount)
 152         where
 153             boxed_size    = iBox size
 154
 155             final_size | inline     = boxed_size `min` max_inline_size
 156                        | otherwise  = boxed_size
 157
 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`
 161
 162             discount_for b = foldlBag (\acc (b',n) -> if b==b' then acc+n else acc)
 163                                       0 cased_args
 164         }
 165   where
 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
 172
 173     go _      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)
 177 \end{code}
 178
 179 \begin{code}
 180 sizeExpr :: FastInt         -- Bomb out if it gets bigger than this
 181          -> [Id]            -- Arguments; we're interested in which of these
 182                             -- get case'd
 183          -> CoreExpr
 184          -> ExprSize
 185
 186 sizeExpr bOMB_OUT_SIZE top_args expr
 187   = size_up expr
 188   where
 189     size_up (Type _)           = sizeZero        -- Types cost nothing
 190     size_up (Var _)            = sizeOne
 191
 192     size_up (Note InlineMe _)  = 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 #-}
 196         --         op1 = ...
 197         --         op2 = ...
 198         -- then we'll get a dfun which is a pair of two INLINE lambdas
 199
 200     size_up (Note _      body) = size_up body  -- Other notes cost nothing
 201
 202     size_up (Cast e _)         = size_up e
 203
 204     size_up (App fun (Type _)) = size_up fun
 205     size_up (App fun arg)      = size_up_app fun [arg]
 206
 207     size_up (Lit lit)          = sizeN (litSize lit)
 208
 209     size_up (Lam b e) | isId b    = lamScrutDiscount (size_up e `addSizeN` 1)
 210                       | otherwise = size_up e
 211
 212     size_up (Let (NonRec binder rhs) body)
 213       = nukeScrutDiscount (size_up rhs)         `addSize`
 214         size_up body                            `addSizeN`
 215         (if isUnLiftedType (idType binder) then 0 else 1)
 216                 -- For the allocation
 217                 -- If the binder has an unlifted type there is no allocation
 218
 219     size_up (Let (Rec pairs) body)
 220       = nukeScrutDiscount rhs_size              `addSize`
 221         size_up body                            `addSizeN`
 222         length pairs            -- For the allocation
 223       where
 224         rhs_size = foldr (addSize . size_up . snd) sizeZero pairs
 225
 226     size_up (Case (Var v) _ _ alts)
 227         | v `elem` top_args             -- We are scrutinising an argument variable
 228         =
 229 {-      I'm nuking this special case; BUT see the comment with case alternatives.
 230
 231         (a) It's too eager.  We don't want to inline a wrapper into a
 232             context with no benefit.
 233             E.g.  \ x. f (x+x)          no point in inlining (+) here!
 234
 235         (b) It's ineffective. Once g's wrapper is inlined, its case-expressions
 236             aren't scrutinising arguments any more
 237
 238             case alts of
 239
 240                 [alt] -> size_up_alt alt `addSize` SizeIs (_ILIT(0)) (unitBag (v, 1)) (_ILIT(0))
 241                 -- We want to make wrapper-style evaluation look cheap, so that
 242                 -- when we inline a wrapper it doesn't make call site (much) bigger
 243                 -- Otherwise we get nasty phase ordering stuff:
 244                 --      f x = g x x
 245                 --      h y = ...(f e)...
 246                 -- If we inline g's wrapper, f looks big, and doesn't get inlined
 247                 -- into h; if we inline f first, while it looks small, then g's
 248                 -- wrapper will get inlined later anyway.  To avoid this nasty
 249                 -- ordering difference, we make (case a of (x,y) -> ...),
 250                 --  *where a is one of the arguments* look free.
 251
 252                 other ->
 253 -}
 254                          alts_size (foldr addSize sizeOne alt_sizes)    -- The 1 is for the scrutinee
 255                                    (foldr1 maxSize alt_sizes)
 256
 257                 -- Good to inline if an arg is scrutinised, because
 258                 -- that may eliminate allocation in the caller
 259                 -- And it eliminates the case itself
 260
 261         where
 262           alt_sizes = map size_up_alt alts
 263
 264                 -- alts_size tries to compute a good discount for
 265                 -- the case when we are scrutinising an argument variable
 266           alts_size (SizeIs tot _tot_disc _tot_scrut)           -- Size of all alternatives
 267                     (SizeIs max  max_disc  max_scrut)           -- Size of biggest alternative
 268                 = SizeIs tot (unitBag (v, iBox (_ILIT(1) +# tot -# max)) `unionBags` max_disc) max_scrut
 269                         -- If the variable is known, we produce a discount that
 270                         -- will take us back to 'max', the size of rh largest alternative
 271                         -- The 1+ is a little discount for reduced allocation in the caller
 272           alts_size tot_size _ = tot_size
 273
 274     size_up (Case e _ _ alts) = nukeScrutDiscount (size_up e) `addSize`
 275                                  foldr (addSize . size_up_alt) sizeZero alts
 276                 -- We don't charge for the case itself
 277                 -- It's a strict thing, and the price of the call
 278                 -- is paid by scrut.  Also consider
 279                 --      case f x of DEFAULT -> e
 280                 -- This is just ';'!  Don't charge for it.
 281
 282     ------------
 283     size_up_app (App fun arg) args
 284         | isTypeArg arg              = size_up_app fun args
 285         | otherwise                  = size_up_app fun (arg:args)
 286     size_up_app fun           args   = foldr (addSize . nukeScrutDiscount . size_up)
 287                                              (size_up_fun fun args)
 288                                              args
 289
 290         -- A function application with at least one value argument
 291         -- so if the function is an argument give it an arg-discount
 292         --
 293         -- Also behave specially if the function is a build
 294         --
 295         -- Also if the function is a constant Id (constr or primop)
 296         -- compute discounts specially
 297     size_up_fun (Var fun) args
 298       | fun `hasKey` buildIdKey   = buildSize
 299       | fun `hasKey` augmentIdKey = augmentSize
 300       | otherwise
 301       = case globalIdDetails fun of
 302           DataConWorkId dc -> conSizeN dc (valArgCount args)
 303
 304           FCallId _    -> sizeN opt_UF_DearOp
 305           PrimOpId op  -> primOpSize op (valArgCount args)
 306                           -- foldr addSize (primOpSize op) (map arg_discount args)
 307                           -- At one time I tried giving an arg-discount if a primop
 308                           -- is applied to one of the function's arguments, but it's
 309                           -- not good.  At the moment, any unlifted-type arg gets a
 310                           -- 'True' for 'yes I'm evald', so we collect the discount even
 311                           -- if we know nothing about it.  And just having it in a primop
 312                           -- doesn't help at all if we don't know something more.
 313
 314           _            -> fun_discount fun `addSizeN`
 315                           (1 + length (filter (not . exprIsTrivial) args))
 316                                 -- The 1+ is for the function itself
 317                                 -- Add 1 for each non-trivial arg;
 318                                 -- the allocation cost, as in let(rec)
 319                                 -- Slight hack here: for constructors the args are almost always
 320                                 --      trivial; and for primops they are almost always prim typed
 321                                 --      We should really only count for non-prim-typed args in the
 322                                 --      general case, but that seems too much like hard work
 323
 324     size_up_fun other _ = size_up other
 325
 326     ------------
 327     size_up_alt (_con, _bndrs, rhs) = size_up rhs
 328         -- Don't charge for args, so that wrappers look cheap
 329         -- (See comments about wrappers with Case)
 330
 331     ------------
 332         -- We want to record if we're case'ing, or applying, an argument
 333     fun_discount v | v `elem` top_args = SizeIs (_ILIT(0)) (unitBag (v, opt_UF_FunAppDiscount)) (_ILIT(0))
 334     fun_discount _                     = sizeZero
 335
 336     ------------
 337         -- These addSize things have to be here because
 338         -- I don't want to give them bOMB_OUT_SIZE as an argument
 339
 340     addSizeN TooBig          _  = TooBig
 341     addSizeN (SizeIs n xs d) m  = mkSizeIs bOMB_OUT_SIZE (n +# iUnbox m) xs d
 342
 343     addSize TooBig            _                 = TooBig
 344     addSize _                 TooBig            = TooBig
 345     addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
 346         = mkSizeIs bOMB_OUT_SIZE (n1 +# n2) (xs `unionBags` ys) (d1 +# d2)
 347 \end{code}
 348
 349 Code for manipulating sizes
 350
 351 \begin{code}
 352 data ExprSize = TooBig
 353               | SizeIs FastInt          -- Size found
 354                        (Bag (Id,Int))   -- Arguments cased herein, and discount for each such
 355                        FastInt          -- Size to subtract if result is scrutinised
 356                                         -- by a case expression
 357
 358 -- subtract the discount before deciding whether to bale out. eg. we
 359 -- want to inline a large constructor application into a selector:
 360 --      tup = (a_1, ..., a_99)
 361 --      x = case tup of ...
 362 --
 363 mkSizeIs :: FastInt -> FastInt -> Bag (Id, Int) -> FastInt -> ExprSize
 364 mkSizeIs max n xs d | (n -# d) ># max = TooBig
 365                     | otherwise       = SizeIs n xs d
 366
 367 maxSize :: ExprSize -> ExprSize -> ExprSize
 368 maxSize TooBig         _                                  = TooBig
 369 maxSize _              TooBig                             = TooBig
 370 maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 ># n2  = s1
 371                                               | otherwise = s2
 372
 373 sizeZero, sizeOne :: ExprSize
 374 sizeN :: Int -> ExprSize
 375 conSizeN :: DataCon ->Int -> ExprSize
 376
 377 sizeZero        = SizeIs (_ILIT(0))  emptyBag (_ILIT(0))
 378 sizeOne         = SizeIs (_ILIT(1))  emptyBag (_ILIT(0))
 379 sizeN n         = SizeIs (iUnbox n) emptyBag (_ILIT(0))
 380 conSizeN dc n
 381   | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (iUnbox n +# _ILIT(1))
 382   | otherwise            = SizeIs (_ILIT(1)) emptyBag (iUnbox n +# _ILIT(1))
 383         -- Treat constructors as size 1; we are keen to expose them
 384         -- (and we charge separately for their args).  We can't treat
 385         -- them as size zero, else we find that (iBox x) has size 1,
 386         -- which is the same as a lone variable; and hence 'v' will
 387         -- always be replaced by (iBox x), where v is bound to iBox x.
 388         --
 389         -- However, unboxed tuples count as size zero
 390         -- I found occasions where we had
 391         --      f x y z = case op# x y z of { s -> (# s, () #) }
 392         -- and f wasn't getting inlined
 393
 394 primOpSize :: PrimOp -> Int -> ExprSize
 395 primOpSize op n_args
 396  | not (primOpIsDupable op) = sizeN opt_UF_DearOp
 397  | not (primOpOutOfLine op) = sizeN (2 - n_args)
 398         -- Be very keen to inline simple primops.
 399         -- We give a discount of 1 for each arg so that (op# x y z) costs 2.
 400         -- We can't make it cost 1, else we'll inline let v = (op# x y z)
 401         -- at every use of v, which is excessive.
 402         --
 403         -- A good example is:
 404         --      let x = +# p q in C {x}
 405         -- Even though x get's an occurrence of 'many', its RHS looks cheap,
 406         -- and there's a good chance it'll get inlined back into C's RHS. Urgh!
 407  | otherwise                = sizeOne
 408
 409 buildSize :: ExprSize
 410 buildSize = SizeIs (_ILIT(-2)) emptyBag (_ILIT(4))
 411         -- We really want to inline applications of build
 412         -- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
 413         -- Indeed, we should add a result_discount becuause build is
 414         -- very like a constructor.  We don't bother to check that the
 415         -- build is saturated (it usually is).  The "-2" discounts for the \c n,
 416         -- The "4" is rather arbitrary.
 417
 418 augmentSize :: ExprSize
 419 augmentSize = SizeIs (_ILIT(-2)) emptyBag (_ILIT(4))
 420         -- Ditto (augment t (\cn -> e) ys) should cost only the cost of
 421         -- e plus ys. The -2 accounts for the \cn
 422
 423 nukeScrutDiscount :: ExprSize -> ExprSize
 424 nukeScrutDiscount (SizeIs n vs _) = SizeIs n vs (_ILIT(0))
 425 nukeScrutDiscount TooBig          = TooBig
 426
 427 -- When we return a lambda, give a discount if it's used (applied)
 428 lamScrutDiscount :: ExprSize -> ExprSize
 429 lamScrutDiscount (SizeIs n vs _) = case opt_UF_FunAppDiscount of { d -> SizeIs n vs (iUnbox d) }
 430 lamScrutDiscount TooBig          = TooBig
 431 \end{code}
 432
 433
 434 %************************************************************************
 435 %*                                                                      *
 436 \subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}
 437 %*                                                                      *
 438 %************************************************************************
 439
 440 We have very limited information about an unfolding expression: (1)~so
 441 many type arguments and so many value arguments expected---for our
 442 purposes here, we assume we've got those.  (2)~A ``size'' or ``cost,''
 443 a single integer.  (3)~An ``argument info'' vector.  For this, what we
 444 have at the moment is a Boolean per argument position that says, ``I
 445 will look with great favour on an explicit constructor in this
 446 position.'' (4)~The ``discount'' to subtract if the expression
 447 is being scrutinised.
 448
 449 Assuming we have enough type- and value arguments (if not, we give up
 450 immediately), then we see if the ``discounted size'' is below some
 451 (semi-arbitrary) threshold.  It works like this: for every argument
 452 position where we're looking for a constructor AND WE HAVE ONE in our
 453 hands, we get a (again, semi-arbitrary) discount [proportion to the
 454 number of constructors in the type being scrutinized].
 455
 456 If we're in the context of a scrutinee ( \tr{(case <expr > of A .. -> ...;.. )})
 457 and the expression in question will evaluate to a constructor, we use
 458 the computed discount size *for the result only* rather than
 459 computing the argument discounts. Since we know the result of
 460 the expression is going to be taken apart, discounting its size
 461 is more accurate (see @sizeExpr@ above for how this discount size
 462 is computed).
 463
 464 We use this one to avoid exporting inlinings that we ``couldn't possibly
 465 use'' on the other side.  Can be overridden w/ flaggery.
 466 Just the same as smallEnoughToInline, except that it has no actual arguments.
 467
 468 \begin{code}
 469 couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
 470 couldBeSmallEnoughToInline threshold rhs = case calcUnfoldingGuidance threshold rhs of
 471                                                 UnfoldNever -> False
 472                                                 _           -> True
 473
 474 certainlyWillInline :: Unfolding -> Bool
 475   -- Sees if the unfolding is pretty certain to inline
 476 certainlyWillInline (CoreUnfolding _ _ _ is_cheap (UnfoldIfGoodArgs n_vals _ size _))
 477   = is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold
 478 certainlyWillInline _
 479   = False
 480
 481 smallEnoughToInline :: Unfolding -> Bool
 482 smallEnoughToInline (CoreUnfolding _ _ _ _ (UnfoldIfGoodArgs _ _ size _))
 483   = size <= opt_UF_UseThreshold
 484 smallEnoughToInline _
 485   = False
 486 \end{code}
 487
 488 %************************************************************************
 489 %*                                                                      *
 490 \subsection{callSiteInline}
 491 %*                                                                      *
 492 %************************************************************************
 493
 494 This is the key function.  It decides whether to inline a variable at a call site
 495
 496 callSiteInline is used at call sites, so it is a bit more generous.
 497 It's a very important function that embodies lots of heuristics.
 498 A non-WHNF can be inlined if it doesn't occur inside a lambda,
 499 and occurs exactly once or
 500     occurs once in each branch of a case and is small
 501
 502 If the thing is in WHNF, there's no danger of duplicating work,
 503 so we can inline if it occurs once, or is small
 504
 505 NOTE: we don't want to inline top-level functions that always diverge.
 506 It just makes the code bigger.  Tt turns out that the convenient way to prevent
 507 them inlining is to give them a NOINLINE pragma, which we do in
 508 StrictAnal.addStrictnessInfoToTopId
 509
 510 \begin{code}
 511 callSiteInline :: DynFlags
 512                -> Bool                  -- True <=> the Id can be inlined
 513                -> Id                    -- The Id
 514                -> Bool                  -- True if there are are no arguments at all (incl type args)
 515                -> [Bool]                -- One for each value arg; True if it is interesting
 516                -> CallContInfo          -- True <=> continuation is interesting
 517                -> Maybe CoreExpr        -- Unfolding, if any
 518
 519
 520 data CallContInfo = BoringCont
 521                   | InterestingCont     -- Somewhat interesting
 522                   | CaseCont            -- Very interesting; the argument of a case
 523                                         -- that decomposes its scrutinee
 524
 525 instance Outputable CallContInfo where
 526   ppr BoringCont      = ptext SLIT("BoringCont")
 527   ppr InterestingCont = ptext SLIT("InterestingCont")
 528   ppr CaseCont        = ptext SLIT("CaseCont")
 529
 530 callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 531   = case idUnfolding id of {
 532         NoUnfolding -> Nothing ;
 533         OtherCon _  -> Nothing ;
 534
 535         CompulsoryUnfolding unf_template -> Just unf_template ;
 536                 -- CompulsoryUnfolding => there is no top-level binding
 537                 -- for these things, so we must inline it.
 538                 -- Only a couple of primop-like things have
 539                 -- compulsory unfoldings (see MkId.lhs).
 540                 -- We don't allow them to be inactive
 541
 542         CoreUnfolding unf_template is_top is_value is_cheap guidance ->
 543
 544     let
 545         result | yes_or_no = Just unf_template
 546                | otherwise = Nothing
 547
 548         n_val_args  = length arg_infos
 549
 550         yes_or_no = active_inline && is_cheap && consider_safe
 551                 -- We consider even the once-in-one-branch
 552                 -- occurrences, because they won't all have been
 553                 -- caught by preInlineUnconditionally.  In particular,
 554                 -- if the occurrence is once inside a lambda, and the
 555                 -- rhs is cheap but not a manifest lambda, then
 556                 -- pre-inline will not have inlined it for fear of
 557                 -- invalidating the occurrence info in the rhs.
 558
 559         consider_safe
 560                 -- consider_safe decides whether it's a good idea to
 561                 -- inline something, given that there's no
 562                 -- work-duplication issue (the caller checks that).
 563           = case guidance of
 564               UnfoldNever  -> False
 565               UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount
 566                   | enough_args && size <= (n_vals_wanted + 1)
 567                         -- Inline unconditionally if there no size increase
 568                         -- Size of call is n_vals_wanted (+1 for the function)
 569                   -> True
 570
 571                   | otherwise
 572                   -> some_benefit && small_enough
 573
 574                   where
 575                     enough_args = n_val_args >= n_vals_wanted
 576
 577                     some_benefit = or arg_infos || really_interesting_cont
 578                                 -- There must be something interesting
 579                                 -- about some argument, or the result
 580                                 -- context, to make it worth inlining
 581
 582                     really_interesting_cont
 583                         | n_val_args <  n_vals_wanted = False   -- Too few args
 584                         | n_val_args == n_vals_wanted = interesting_saturated_call
 585                         | otherwise                   = True    -- Extra args
 586                         -- really_interesting_cont tells if the result of the
 587                         -- call is in an interesting context.
 588
 589                     interesting_saturated_call
 590                         = case cont_info of
 591                             BoringCont -> not is_top && n_vals_wanted > 0       -- Note [Nested functions]
 592                             CaseCont   -> not lone_variable || not is_value     -- Note [Lone variables]
 593                             InterestingCont -> n_vals_wanted > 0
 594
 595                     small_enough = (size - discount) <= opt_UF_UseThreshold
 596                     discount = computeDiscount n_vals_wanted arg_discounts
 597                                                res_discount' arg_infos
 598                     res_discount' = case cont_info of
 599                                         BoringCont      -> 0
 600                                         CaseCont        -> res_discount
 601                                         InterestingCont -> 4 `min` res_discount
 602                         -- res_discount can be very large when a function returns
 603                         -- construtors; but we only want to invoke that large discount
 604                         -- when there's a case continuation.
 605                         -- Otherwise we, rather arbitrarily, threshold it.  Yuk.
 606                         -- But we want to aovid inlining large functions that return
 607                         -- constructors into contexts that are simply "interesting"
 608
 609     in
 610     if dopt Opt_D_dump_inlinings dflags then
 611         pprTrace "Considering inlining"
 612                  (ppr id <+> vcat [text "active:" <+> ppr active_inline,
 613                                    text "arg infos" <+> ppr arg_infos,
 614                                    text "interesting continuation" <+> ppr cont_info,
 615                                    text "is value:" <+> ppr is_value,
 616                                    text "is cheap:" <+> ppr is_cheap,
 617                                    text "guidance" <+> ppr guidance,
 618                                    text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
 619                   result
 620     else
 621     result
 622     }
 623 \end{code}
 624
 625 Note [Nested functions]
 626 ~~~~~~~~~~~~~~~~~~~~~~~
 627 If a function has a nested defn we also record some-benefit, on the
 628 grounds that we are often able to eliminate the binding, and hence the
 629 allocation, for the function altogether; this is good for join points.
 630 But this only makes sense for *functions*; inlining a constructor
 631 doesn't help allocation unless the result is scrutinised.  UNLESS the
 632 constructor occurs just once, albeit possibly in multiple case
 633 branches.  Then inlining it doesn't increase allocation, but it does
 634 increase the chance that the constructor won't be allocated at all in
 635 the branches that don't use it.
 636
 637 Note [Lone variables]
 638 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 639 The "lone-variable" case is important.  I spent ages messing about
 640 with unsatisfactory varaints, but this is nice.  The idea is that if a
 641 variable appears all alone
 642         as an arg of lazy fn, or rhs    Stop
 643         as scrutinee of a case          Select
 644         as arg of a strict fn           ArgOf
 645 AND
 646         it is bound to a value
 647 then we should not inline it (unless there is some other reason,
 648 e.g. is is the sole occurrence).  That is what is happening at
 649 the use of 'lone_variable' in 'interesting_saturated_call'.
 650
 651 Why?  At least in the case-scrutinee situation, turning
 652         let x = (a,b) in case x of y -> ...
 653 into
 654         let x = (a,b) in case (a,b) of y -> ...
 655 and thence to
 656         let x = (a,b) in let y = (a,b) in ...
 657 is bad if the binding for x will remain.
 658
 659 Another example: I discovered that strings
 660 were getting inlined straight back into applications of 'error'
 661 because the latter is strict.
 662         s = "foo"
 663         f = \x -> ...(error s)...
 664
 665 Fundamentally such contexts should not encourage inlining because the
 666 context can ``see'' the unfolding of the variable (e.g. case or a
 667 RULE) so there's no gain.  If the thing is bound to a value.
 668
 669 However, watch out:
 670
 671  * Consider this:
 672         foo = _inline_ (\n. [n])
 673         bar = _inline_ (foo 20)
 674         baz = \n. case bar of { (m:_) -> m + n }
 675    Here we really want to inline 'bar' so that we can inline 'foo'
 676    and the whole thing unravels as it should obviously do.  This is
 677    important: in the NDP project, 'bar' generates a closure data
 678    structure rather than a list.
 679
 680  * Even a type application or coercion isn't a lone variable.
 681    Consider
 682         case $fMonadST @ RealWorld of { :DMonad a b c -> c }
 683    We had better inline that sucker!  The case won't see through it.
 684
 685    For now, I'm treating treating a variable applied to types
 686    in a *lazy* context "lone". The motivating example was
 687         f = /\a. \x. BIG
 688         g = /\a. \y.  h (f a)
 689    There's no advantage in inlining f here, and perhaps
 690    a significant disadvantage.  Hence some_val_args in the Stop case
 691
 692 \begin{code}
 693 computeDiscount :: Int -> [Int] -> Int -> [Bool] -> Int
 694 computeDiscount n_vals_wanted arg_discounts result_discount arg_infos
 695         -- We multiple the raw discounts (args_discount and result_discount)
 696         -- ty opt_UnfoldingKeenessFactor because the former have to do with
 697         --  *size* whereas the discounts imply that there's some extra
 698         --  *efficiency* to be gained (e.g. beta reductions, case reductions)
 699         -- by inlining.
 700
 701         -- we also discount 1 for each argument passed, because these will
 702         -- reduce with the lambdas in the function (we count 1 for a lambda
 703         -- in size_up).
 704   = 1 +                 -- Discount of 1 because the result replaces the call
 705                         -- so we count 1 for the function itself
 706     length (take n_vals_wanted arg_infos) +
 707                         -- Discount of 1 for each arg supplied, because the
 708                         -- result replaces the call
 709     round (opt_UF_KeenessFactor *
 710            fromIntegral (arg_discount + result_discount))
 711   where
 712     arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)
 713
 714     mk_arg_discount discount is_evald | is_evald  = discount
 715                                       | otherwise = 0
 716 \end{code}