ghc/compiler/coreSyn/CoreUnfold.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1998
   3 %
   4 \section[CoreUnfold]{Core-syntax unfoldings}
   5
   6 Unfoldings (which can travel across module boundaries) are in Core
   7 syntax (namely @CoreExpr@s).
   8
   9 The type @Unfolding@ sits ``above'' simply-Core-expressions
  10 unfoldings, capturing ``higher-level'' things we know about a binding,
  11 usually things that the simplifier found out (e.g., ``it's a
  12 literal'').  In the corner of a @CoreUnfolding@ unfolding, you will
  13 find, unsurprisingly, a Core expression.
  14
  15 \begin{code}
  16 module CoreUnfold (
  17         Unfolding, UnfoldingGuidance, -- types
  18
  19         noUnfolding, mkUnfolding, seqUnfolding,
  20         mkOtherCon, otherCons,
  21         unfoldingTemplate, maybeUnfoldingTemplate,
  22         isEvaldUnfolding, isCheapUnfolding,
  23         hasUnfolding, hasSomeUnfolding,
  24
  25         couldBeSmallEnoughToInline,
  26         certainlySmallEnoughToInline,
  27         okToUnfoldInHiFile,
  28
  29         calcUnfoldingGuidance,
  30
  31         callSiteInline, blackListed
  32     ) where
  33
  34 #include "HsVersions.h"
  35
  36 import CmdLineOpts      ( opt_UF_CreationThreshold,
  37                           opt_UF_UseThreshold,
  38                           opt_UF_ScrutConDiscount,
  39                           opt_UF_FunAppDiscount,
  40                           opt_UF_PrimArgDiscount,
  41                           opt_UF_KeenessFactor,
  42                           opt_UF_CheapOp, opt_UF_DearOp, opt_UF_NoRepLit,
  43                           opt_UnfoldCasms, opt_PprStyle_Debug,
  44                           opt_D_dump_inlinings
  45                         )
  46 import CoreSyn
  47 import PprCore          ( pprCoreExpr )
  48 import OccurAnal        ( occurAnalyseGlobalExpr )
  49 import BinderInfo       ( )
  50 import CoreUtils        ( coreExprType, exprIsTrivial, exprIsValue, exprIsCheap )
  51 import Id               ( Id, idType, idUnique, isId,
  52                           getIdSpecialisation, getInlinePragma, getIdUnfolding
  53                         )
  54 import VarSet
  55 import Name             ( isLocallyDefined )
  56 import Const            ( Con(..), isLitLitLit, isWHNFCon )
  57 import PrimOp           ( PrimOp(..), primOpIsDupable )
  58 import IdInfo           ( ArityInfo(..), InlinePragInfo(..), OccInfo(..) )
  59 import TyCon            ( tyConFamilySize )
  60 import Type             ( splitAlgTyConApp_maybe, splitFunTy_maybe, isUnLiftedType )
  61 import Const            ( isNoRepLit )
  62 import Unique           ( Unique, buildIdKey, augmentIdKey, runSTRepIdKey )
  63 import Maybes           ( maybeToBool )
  64 import Bag
  65 import Util             ( isIn, lengthExceeds )
  66 import Outputable
  67 \end{code}
  68
  69 %************************************************************************
  70 %*                                                                      *
  71 \subsection{@Unfolding@ and @UnfoldingGuidance@ types}
  72 %*                                                                      *
  73 %************************************************************************
  74
  75 \begin{code}
  76 data Unfolding
  77   = NoUnfolding
  78
  79   | OtherCon [Con]              -- It ain't one of these
  80                                 -- (OtherCon xs) also indicates that something has been evaluated
  81                                 -- and hence there's no point in re-evaluating it.
  82                                 -- OtherCon [] is used even for non-data-type values
  83                                 -- to indicated evaluated-ness.  Notably:
  84                                 --      data C = C !(Int -> Int)
  85                                 --      case x of { C f -> ... }
  86                                 -- Here, f gets an OtherCon [] unfolding.
  87
  88   | CoreUnfolding                       -- An unfolding with redundant cached information
  89                 CoreExpr                -- Template; binder-info is correct
  90                 Bool                    -- exprIsCheap template (cached); it won't duplicate (much) work
  91                                         --      if you inline this in more than one place
  92                 Bool                    -- exprIsValue template (cached); it is ok to discard a `seq` on
  93                                         --      this variable
  94                 UnfoldingGuidance       -- Tells about the *size* of the template.
  95
  96 seqUnfolding :: Unfolding -> ()
  97 seqUnfolding (CoreUnfolding e b1 b2 g)
  98   = seqExpr e `seq` b1 `seq` b2 `seq` seqGuidance g
  99 seqUnfolding other = ()
 100 \end{code}
 101
 102 \begin{code}
 103 noUnfolding = NoUnfolding
 104 mkOtherCon  = OtherCon
 105
 106 mkUnfolding expr
 107   = CoreUnfolding (occurAnalyseGlobalExpr expr)
 108                   (exprIsCheap expr)
 109                   (exprIsValue expr)
 110                   (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
 111
 112 unfoldingTemplate :: Unfolding -> CoreExpr
 113 unfoldingTemplate (CoreUnfolding expr _ _ _) = expr
 114 unfoldingTemplate other = panic "getUnfoldingTemplate"
 115
 116 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
 117 maybeUnfoldingTemplate (CoreUnfolding expr _ _ _) = Just expr
 118 maybeUnfoldingTemplate other                      = Nothing
 119
 120 otherCons (OtherCon cons) = cons
 121 otherCons other           = []
 122
 123 isEvaldUnfolding :: Unfolding -> Bool
 124 isEvaldUnfolding (OtherCon _)                   = True
 125 isEvaldUnfolding (CoreUnfolding _ _ is_evald _) = is_evald
 126 isEvaldUnfolding other                          = False
 127
 128 isCheapUnfolding :: Unfolding -> Bool
 129 isCheapUnfolding (CoreUnfolding _ is_cheap _ _) = is_cheap
 130 isCheapUnfolding other                          = False
 131
 132 hasUnfolding :: Unfolding -> Bool
 133 hasUnfolding (CoreUnfolding _ _ _ _) = True
 134 hasUnfolding other                   = False
 135
 136 hasSomeUnfolding :: Unfolding -> Bool
 137 hasSomeUnfolding NoUnfolding = False
 138 hasSomeUnfolding other       = True
 139
 140 data UnfoldingGuidance
 141   = UnfoldNever
 142   | UnfoldAlways                -- There is no "original" definition,
 143                                 -- so you'd better unfold.  Or: something
 144                                 -- so cheap to unfold (e.g., 1#) that
 145                                 -- you should do it absolutely always.
 146
 147   | UnfoldIfGoodArgs    Int     -- and "n" value args
 148
 149                         [Int]   -- Discount if the argument is evaluated.
 150                                 -- (i.e., a simplification will definitely
 151                                 -- be possible).  One elt of the list per *value* arg.
 152
 153                         Int     -- The "size" of the unfolding; to be elaborated
 154                                 -- later. ToDo
 155
 156                         Int     -- Scrutinee discount: the discount to substract if the thing is in
 157                                 -- a context (case (thing args) of ...),
 158                                 -- (where there are the right number of arguments.)
 159
 160 seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
 161 seqGuidance other                       = ()
 162 \end{code}
 163
 164 \begin{code}
 165 instance Outputable UnfoldingGuidance where
 166     ppr UnfoldAlways    = ptext SLIT("ALWAYS")
 167     ppr UnfoldNever     = ptext SLIT("NEVER")
 168     ppr (UnfoldIfGoodArgs v cs size discount)
 169       = hsep [ptext SLIT("IF_ARGS"), int v,
 170                if null cs       -- always print *something*
 171                 then char 'X'
 172                 else hcat (map (text . show) cs),
 173                int size,
 174                int discount ]
 175 \end{code}
 176
 177
 178 %************************************************************************
 179 %*                                                                      *
 180 \subsection[calcUnfoldingGuidance]{Calculate ``unfolding guidance'' for an expression}
 181 %*                                                                      *
 182 %************************************************************************
 183
 184 \begin{code}
 185 calcUnfoldingGuidance
 186         :: Int                  -- bomb out if size gets bigger than this
 187         -> CoreExpr             -- expression to look at
 188         -> UnfoldingGuidance
 189 calcUnfoldingGuidance bOMB_OUT_SIZE expr
 190   | exprIsTrivial expr          -- Often trivial expressions are never bound
 191                                 -- to an expression, but it can happen.  For
 192                                 -- example, the Id for a nullary constructor has
 193                                 -- a trivial expression as its unfolding, and
 194                                 -- we want to make sure that we always unfold it.
 195   = UnfoldAlways
 196
 197   | otherwise
 198   = case collectBinders expr of { (binders, body) ->
 199     let
 200         val_binders = filter isId binders
 201     in
 202     case (sizeExpr bOMB_OUT_SIZE val_binders body) of
 203
 204       TooBig -> UnfoldNever
 205
 206       SizeIs size cased_args scrut_discount
 207         -> UnfoldIfGoodArgs
 208                         (length val_binders)
 209                         (map discount_for val_binders)
 210                         (I# size)
 211                         (I# scrut_discount)
 212         where
 213             discount_for b
 214                 | num_cases == 0 = 0
 215                 | is_fun_ty      = num_cases * opt_UF_FunAppDiscount
 216                 | is_data_ty     = num_cases * opt_UF_ScrutConDiscount
 217                 | otherwise      = num_cases * opt_UF_PrimArgDiscount
 218                 where
 219                   num_cases           = foldlBag (\n b' -> if b==b' then n+1 else n) 0 cased_args
 220                                         -- Count occurrences of b in cased_args
 221                   arg_ty              = idType b
 222                   is_fun_ty           = maybeToBool (splitFunTy_maybe arg_ty)
 223                   (is_data_ty, tycon) = case (splitAlgTyConApp_maybe (idType b)) of
 224                                           Nothing       -> (False, panic "discount")
 225                                           Just (tc,_,_) -> (True,  tc)
 226         }
 227 \end{code}
 228
 229 \begin{code}
 230 sizeExpr :: Int             -- Bomb out if it gets bigger than this
 231          -> [Id]            -- Arguments; we're interested in which of these
 232                             -- get case'd
 233          -> CoreExpr
 234          -> ExprSize
 235
 236 sizeExpr (I# bOMB_OUT_SIZE) args expr
 237   = size_up expr
 238   where
 239     size_up (Type t)          = sizeZero        -- Types cost nothing
 240     size_up (Var v)           = sizeOne
 241
 242     size_up (Note InlineMe _) = sizeTwo         -- The idea is that this is one more
 243                                                 -- than the size of the "call" (i.e. 1)
 244                                                 -- We want to reply "no" to noSizeIncrease
 245                                                 -- for a bare reference (i.e. applied to no args)
 246                                                 -- to an INLINE thing
 247
 248     size_up (Note _ body)     = size_up body    -- Notes cost nothing
 249
 250     size_up (App fun (Type t))  = size_up fun
 251     size_up (App fun arg)       = size_up_app fun [arg]
 252
 253     size_up (Con con args) = foldr (addSize . size_up)
 254                                    (size_up_con con args)
 255                                    args
 256
 257     size_up (Lam b e) | isId b    = size_up e `addSizeN` 1
 258                       | otherwise = size_up e
 259
 260     size_up (Let (NonRec binder rhs) body)
 261       = nukeScrutDiscount (size_up rhs)         `addSize`
 262         size_up body                            `addSizeN`
 263         (if isUnLiftedType (idType binder) then 0 else 1)
 264                 -- For the allocation
 265                 -- If the binder has an unlifted type there is no allocation
 266
 267     size_up (Let (Rec pairs) body)
 268       = nukeScrutDiscount rhs_size              `addSize`
 269         size_up body                            `addSizeN`
 270         length pairs            -- For the allocation
 271       where
 272         rhs_size = foldr (addSize . size_up . snd) sizeZero pairs
 273
 274     size_up (Case scrut _ alts)
 275       = nukeScrutDiscount (size_up scrut)               `addSize`
 276         arg_discount scrut                              `addSize`
 277         foldr (addSize . size_up_alt) sizeZero alts
 278           `addSizeN` 1  -- charge one for the case itself.
 279
 280 -- Just charge for the alts that exist, not the ones that might exist
 281 --      `addSizeN`
 282 --      case (splitAlgTyConApp_maybe (coreExprType scrut)) of
 283 --              Nothing       -> 1
 284 --              Just (tc,_,_) -> tyConFamilySize tc
 285
 286     ------------
 287     size_up_app (App fun arg) args   = size_up_app fun (arg:args)
 288     size_up_app fun           args   = foldr (addSize . size_up) (fun_discount fun) 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         -- Also behave specially if the function is a build
 293     fun_discount (Var fun) | idUnique fun == buildIdKey   = buildSize
 294                            | idUnique fun == augmentIdKey = augmentSize
 295                            | fun `is_elem` args         = scrutArg fun
 296     fun_discount other                                  = sizeZero
 297
 298     ------------
 299     size_up_alt (con, bndrs, rhs) = size_up rhs
 300             -- Don't charge for args, so that wrappers look cheap
 301
 302     ------------
 303     size_up_con (Literal lit) args | isNoRepLit lit = sizeN opt_UF_NoRepLit
 304                                    | otherwise      = sizeOne
 305
 306     size_up_con (DataCon dc) args = conSizeN (valArgCount args)
 307
 308     size_up_con (PrimOp op) args = foldr addSize (sizeN op_cost) (map arg_discount args)
 309                 -- Give an arg-discount if a primop is applies to
 310                 -- one of the function's arguments
 311       where
 312         op_cost | primOpIsDupable op = opt_UF_CheapOp
 313                 | otherwise          = opt_UF_DearOp
 314
 315         -- We want to record if we're case'ing, or applying, an argument
 316     arg_discount (Var v) | v `is_elem` args = scrutArg v
 317     arg_discount other                      = sizeZero
 318
 319     ------------
 320     is_elem :: Id -> [Id] -> Bool
 321     is_elem = isIn "size_up_scrut"
 322
 323     ------------
 324         -- These addSize things have to be here because
 325         -- I don't want to give them bOMB_OUT_SIZE as an argument
 326
 327     addSizeN TooBig          _ = TooBig
 328     addSizeN (SizeIs n xs d) (I# m)
 329       | n_tot -# d <# bOMB_OUT_SIZE = SizeIs n_tot xs d
 330       | otherwise                   = TooBig
 331       where
 332         n_tot = n +# m
 333
 334     addSize TooBig _ = TooBig
 335     addSize _ TooBig = TooBig
 336     addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
 337       | (n_tot -# d_tot) <# bOMB_OUT_SIZE = SizeIs n_tot xys d_tot
 338       | otherwise                         = TooBig
 339       where
 340         n_tot = n1 +# n2
 341         d_tot = d1 +# d2
 342         xys   = xs `unionBags` ys
 343 \end{code}
 344
 345 Code for manipulating sizes
 346
 347 \begin{code}
 348
 349 data ExprSize = TooBig
 350               | SizeIs Int#     -- Size found
 351                        (Bag Id) -- Arguments cased herein
 352                        Int#     -- Size to subtract if result is scrutinised
 353                                 -- by a case expression
 354
 355 sizeZero        = SizeIs 0# emptyBag 0#
 356 sizeOne         = SizeIs 1# emptyBag 0#
 357 sizeTwo         = SizeIs 2# emptyBag 0#
 358 sizeN (I# n)    = SizeIs n  emptyBag 0#
 359 conSizeN (I# n) = SizeIs 1# emptyBag (n +# 1#)
 360         -- Treat constructors as size 1, that unfoldAlways responsds 'False'
 361         -- when asked about 'x' when x is bound to (C 3#).
 362         -- This avoids gratuitous 'ticks' when x itself appears as an
 363         -- atomic constructor argument.
 364
 365 buildSize = SizeIs (-2#) emptyBag 4#
 366         -- We really want to inline applications of build
 367         -- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
 368         -- Indeed, we should add a result_discount becuause build is
 369         -- very like a constructor.  We don't bother to check that the
 370         -- build is saturated (it usually is).  The "-2" discounts for the \c n,
 371         -- The "4" is rather arbitrary.
 372
 373 augmentSize = SizeIs (-2#) emptyBag 4#
 374         -- Ditto (augment t (\cn -> e) ys) should cost only the cost of
 375         -- e plus ys. The -2 accounts for the \cn
 376
 377 scrutArg v      = SizeIs 0# (unitBag v) 0#
 378
 379 nukeScrutDiscount (SizeIs n vs d) = SizeIs n vs 0#
 380 nukeScrutDiscount TooBig          = TooBig
 381 \end{code}
 382
 383
 384 %************************************************************************
 385 %*                                                                      *
 386 \subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}
 387 %*                                                                      *
 388 %************************************************************************
 389
 390 We have very limited information about an unfolding expression: (1)~so
 391 many type arguments and so many value arguments expected---for our
 392 purposes here, we assume we've got those.  (2)~A ``size'' or ``cost,''
 393 a single integer.  (3)~An ``argument info'' vector.  For this, what we
 394 have at the moment is a Boolean per argument position that says, ``I
 395 will look with great favour on an explicit constructor in this
 396 position.'' (4)~The ``discount'' to subtract if the expression
 397 is being scrutinised.
 398
 399 Assuming we have enough type- and value arguments (if not, we give up
 400 immediately), then we see if the ``discounted size'' is below some
 401 (semi-arbitrary) threshold.  It works like this: for every argument
 402 position where we're looking for a constructor AND WE HAVE ONE in our
 403 hands, we get a (again, semi-arbitrary) discount [proportion to the
 404 number of constructors in the type being scrutinized].
 405
 406 If we're in the context of a scrutinee ( \tr{(case <expr > of A .. -> ...;.. )})
 407 and the expression in question will evaluate to a constructor, we use
 408 the computed discount size *for the result only* rather than
 409 computing the argument discounts. Since we know the result of
 410 the expression is going to be taken apart, discounting its size
 411 is more accurate (see @sizeExpr@ above for how this discount size
 412 is computed).
 413
 414 We use this one to avoid exporting inlinings that we ``couldn't possibly
 415 use'' on the other side.  Can be overridden w/ flaggery.
 416 Just the same as smallEnoughToInline, except that it has no actual arguments.
 417
 418 \begin{code}
 419 couldBeSmallEnoughToInline :: UnfoldingGuidance -> Bool
 420 couldBeSmallEnoughToInline UnfoldNever = False
 421 couldBeSmallEnoughToInline other       = True
 422
 423 certainlySmallEnoughToInline :: UnfoldingGuidance -> Bool
 424 certainlySmallEnoughToInline UnfoldNever                   = False
 425 certainlySmallEnoughToInline UnfoldAlways                  = True
 426 certainlySmallEnoughToInline (UnfoldIfGoodArgs _ _ size _) = size <= opt_UF_UseThreshold
 427 \end{code}
 428
 429 @okToUnfoldInHifile@ is used when emitting unfolding info into an interface
 430 file to determine whether an unfolding candidate really should be unfolded.
 431 The predicate is needed to prevent @_casm_@s (+ lit-lits) from being emitted
 432 into interface files.
 433
 434 The reason for inlining expressions containing _casm_s into interface files
 435 is that these fragments of C are likely to mention functions/#defines that
 436 will be out-of-scope when inlined into another module. This is not an
 437 unfixable problem for the user (just need to -#include the approp. header
 438 file), but turning it off seems to the simplest thing to do.
 439
 440 \begin{code}
 441 okToUnfoldInHiFile :: CoreExpr -> Bool
 442 okToUnfoldInHiFile e = opt_UnfoldCasms || go e
 443  where
 444     -- Race over an expression looking for CCalls..
 445     go (Var _)                = True
 446     go (Con (Literal lit) _)  = not (isLitLitLit lit)
 447     go (Con (PrimOp op) args) = okToUnfoldPrimOp op && all go args
 448     go (Con con args)         = True -- con args are always atomic
 449     go (App fun arg)          = go fun && go arg
 450     go (Lam _ body)           = go body
 451     go (Let binds body)       = and (map go (body :rhssOfBind binds))
 452     go (Case scrut bndr alts) = and (map go (scrut:rhssOfAlts alts))
 453     go (Note _ body)          = go body
 454     go (Type _)               = True
 455
 456     -- ok to unfold a PrimOp as long as it's not a _casm_
 457     okToUnfoldPrimOp (CCallOp _ is_casm _ _) = not is_casm
 458     okToUnfoldPrimOp _                       = True
 459 \end{code}
 460
 461
 462 %************************************************************************
 463 %*                                                                      *
 464 \subsection{callSiteInline}
 465 %*                                                                      *
 466 %************************************************************************
 467
 468 This is the key function.  It decides whether to inline a variable at a call site
 469
 470 callSiteInline is used at call sites, so it is a bit more generous.
 471 It's a very important function that embodies lots of heuristics.
 472 A non-WHNF can be inlined if it doesn't occur inside a lambda,
 473 and occurs exactly once or
 474     occurs once in each branch of a case and is small
 475
 476 If the thing is in WHNF, there's no danger of duplicating work,
 477 so we can inline if it occurs once, or is small
 478
 479 \begin{code}
 480 callSiteInline :: Bool                  -- True <=> the Id is black listed
 481                -> Bool                  -- 'inline' note at call site
 482                -> Id                    -- The Id
 483                -> [Bool]                -- One for each value arg; True if it is interesting
 484                -> Bool                  -- True <=> continuation is interesting
 485                -> Maybe CoreExpr        -- Unfolding, if any
 486
 487
 488 callSiteInline black_listed inline_call id arg_infos interesting_cont
 489   = case getIdUnfolding id of {
 490         NoUnfolding -> Nothing ;
 491         OtherCon _  -> Nothing ;
 492         CoreUnfolding unf_template is_cheap _ guidance ->
 493
 494     let
 495         result | yes_or_no = Just unf_template
 496                | otherwise = Nothing
 497
 498         inline_prag = getInlinePragma id
 499         n_val_args  = length arg_infos
 500
 501         yes_or_no =
 502             case inline_prag of
 503                 IAmDead           -> pprTrace "callSiteInline: dead" (ppr id) False
 504                 IMustNotBeINLINEd -> False
 505                 IAmALoopBreaker   -> False
 506                 IMustBeINLINEd    -> True       -- Overrides absolutely everything, including the black list
 507                 ICanSafelyBeINLINEd in_lam one_br -> consider in_lam    True  one_br
 508                 NoInlinePragInfo                  -> consider InsideLam False False
 509
 510         consider in_lam once once_in_one_branch
 511           | black_listed = False
 512           | inline_call  = True
 513           | once_in_one_branch  -- Be very keen to inline something if this is its unique occurrence; that
 514                                 -- gives a good chance of eliminating the original binding for the thing.
 515                                 -- The only time we hold back is when substituting inside a lambda;
 516                                 -- then if the context is totally uninteresting (not applied, not scrutinised)
 517                                 -- there is no point in substituting because it might just increase allocation.
 518           = WARN( case in_lam of { NotInsideLam -> True; other -> False },
 519                   text "callSiteInline:oneOcc" <+> ppr id )
 520                 -- If it has one occurrence, not inside a lambda, PreInlineUnconditionally
 521                 -- should have zapped it already
 522             is_cheap && (not (null arg_infos) || interesting_cont)
 523
 524           | otherwise   -- Occurs (textually) more than once, so look at its size
 525           = case guidance of
 526               UnfoldAlways -> True
 527               UnfoldNever  -> False
 528               UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount
 529                 | enough_args && size <= (n_vals_wanted + 1)
 530                         -- No size increase
 531                         -- Size of call is n_vals_wanted (+1 for the function)
 532                 -> case in_lam of
 533                         NotInsideLam -> True
 534                         InsideLam    -> is_cheap
 535
 536                 | not (or arg_infos || really_interesting_cont || once)
 537                         -- If it occurs more than once, there must be something interesting
 538                         -- about some argument, or the result, to make it worth inlining
 539                         -- We also drop this case if the thing occurs once, although perhaps in
 540                         -- several branches.  In this case we are keener about inlining in the hope
 541                         -- that we'll be able to drop the allocation for the function altogether.
 542                 -> False
 543
 544                 | otherwise
 545                 -> case in_lam of
 546                         NotInsideLam -> small_enough
 547                         InsideLam    -> is_cheap && small_enough
 548
 549                 where
 550                   enough_args             = n_val_args >= n_vals_wanted
 551                   really_interesting_cont | n_val_args <  n_vals_wanted = False -- Too few args
 552                                           | n_val_args == n_vals_wanted = interesting_cont
 553                                           | otherwise                   = True  -- Extra args
 554                         -- This rather elaborate defn for really_interesting_cont is important
 555                         -- Consider an I# = INLINE (\x -> I# {x})
 556                         -- The unfolding guidance deems it to have size 2, and no arguments.
 557                         -- So in an application (I# y) we must take the extra arg 'y' as
 558                         -- evidence of an interesting context!
 559
 560                   small_enough = (size - discount) <= opt_UF_UseThreshold
 561                   discount     = computeDiscount n_vals_wanted arg_discounts res_discount
 562                                                  arg_infos really_interesting_cont
 563
 564
 565     in
 566 #ifdef DEBUG
 567     if opt_D_dump_inlinings then
 568         pprTrace "Considering inlining"
 569                  (ppr id <+> vcat [text "black listed" <+> ppr black_listed,
 570                                    text "inline prag:" <+> ppr inline_prag,
 571                                    text "arg infos" <+> ppr arg_infos,
 572                                    text "interesting continuation" <+> ppr interesting_cont,
 573                                    text "is cheap" <+> ppr is_cheap,
 574                                    text "guidance" <+> ppr guidance,
 575                                    text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO",
 576                                    if yes_or_no then
 577                                         text "Unfolding =" <+> pprCoreExpr unf_template
 578                                    else empty])
 579                   result
 580     else
 581 #endif
 582     result
 583     }
 584
 585 computeDiscount :: Int -> [Int] -> Int -> [Bool] -> Bool -> Int
 586 computeDiscount n_vals_wanted arg_discounts res_discount arg_infos result_used
 587         -- We multiple the raw discounts (args_discount and result_discount)
 588         -- ty opt_UnfoldingKeenessFactor because the former have to do with
 589         -- *size* whereas the discounts imply that there's some extra
 590         -- *efficiency* to be gained (e.g. beta reductions, case reductions)
 591         -- by inlining.
 592
 593         -- we also discount 1 for each argument passed, because these will
 594         -- reduce with the lambdas in the function (we count 1 for a lambda
 595         -- in size_up).
 596   = length (take n_vals_wanted arg_infos) +
 597                         -- Discount of 1 for each arg supplied, because the
 598                         -- result replaces the call
 599     round (opt_UF_KeenessFactor *
 600            fromInt (arg_discount + result_discount))
 601   where
 602     arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)
 603
 604     mk_arg_discount discount is_evald | is_evald  = discount
 605                                       | otherwise = 0
 606
 607         -- Don't give a result discount unless there are enough args
 608     result_discount | result_used = res_discount        -- Over-applied, or case scrut
 609                     | otherwise   = 0
 610 \end{code}
 611
 612
 613 %************************************************************************
 614 %*                                                                      *
 615 \subsection{Black-listing}
 616 %*                                                                      *
 617 %************************************************************************
 618
 619 Inlining is controlled by the "Inline phase" number, which is set
 620 by the per-simplification-pass '-finline-phase' flag.
 621
 622 For optimisation we use phase 1,2 and nothing (i.e. no -finline-phase flag)
 623 in that order.  The meanings of these are determined by the @blackListed@ function
 624 here.
 625
 626 \begin{code}
 627 blackListed :: IdSet            -- Used in transformation rules
 628             -> Maybe Int        -- Inline phase
 629             -> Id -> Bool       -- True <=> blacklisted
 630
 631 -- The blackListed function sees whether a variable should *not* be
 632 -- inlined because of the inline phase we are in.  This is the sole
 633 -- place that the inline phase number is looked at.
 634
 635 -- Phase 0: used for 'no imported inlinings please'
 636 -- This prevents wrappers getting inlined which in turn is bad for full laziness
 637 blackListed rule_vars (Just 0)
 638   = \v -> not (isLocallyDefined v)
 639
 640 -- Phase 1: don't inline any rule-y things or things with specialisations
 641 blackListed rule_vars (Just 1)
 642   = \v -> let v_uniq = idUnique v
 643           in v `elemVarSet` rule_vars
 644           || not (isEmptyCoreRules (getIdSpecialisation v))
 645           || v_uniq == runSTRepIdKey
 646
 647 -- Phase 2: allow build/augment to inline, and specialisations
 648 blackListed rule_vars (Just 2)
 649   = \v -> let v_uniq = idUnique v
 650           in (v `elemVarSet` rule_vars && not (v_uniq == buildIdKey ||
 651                                                v_uniq == augmentIdKey))
 652           || v_uniq == runSTRepIdKey
 653
 654 -- Otherwise just go for it
 655 blackListed rule_vars phase
 656   = \v -> False
 657 \end{code}
 658
 659
 660 SLPJ 95/04: Why @runST@ must be inlined very late:
 661 \begin{verbatim}
 662 f x =
 663   runST ( \ s -> let
 664                     (a, s')  = newArray# 100 [] s
 665                     (_, s'') = fill_in_array_or_something a x s'
 666                   in
 667                   freezeArray# a s'' )
 668 \end{verbatim}
 669 If we inline @runST@, we'll get:
 670 \begin{verbatim}
 671 f x = let
 672         (a, s')  = newArray# 100 [] realWorld#{-NB-}
 673         (_, s'') = fill_in_array_or_something a x s'
 674       in
 675       freezeArray# a s''
 676 \end{verbatim}
 677 And now the @newArray#@ binding can be floated to become a CAF, which
 678 is totally and utterly wrong:
 679 \begin{verbatim}
 680 f = let
 681     (a, s')  = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
 682     in
 683     \ x ->
 684         let (_, s'') = fill_in_array_or_something a x s' in
 685         freezeArray# a s''
 686 \end{verbatim}
 687 All calls to @f@ will share a {\em single} array!
 688
 689 Yet we do want to inline runST sometime, so we can avoid
 690 needless code.  Solution: black list it until the last moment.
 691