    {-
    (c) The University of Glasgow 2006
    (c) The AQUA Project, Glasgow University, 1994-1998

    Core-syntax unfoldings

    Unfoldings (which can travel across module boundaries) are in Core
    syntax (namely @CoreExpr@s).

    The type @Unfolding@ sits ``above'' simply-Core-expressions
    unfoldings, capturing ``higher-level'' things we know about a binding,
    usually things that the simplifier found out (e.g., ``it's a
    literal'').  In the corner of a @CoreUnfolding@ unfolding, you will
    find, unsurprisingly, a Core expression.
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE BangPatterns #-}

    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

    module GHC.Core.Unfold (
            Unfolding, UnfoldingGuidance,   -- Abstract types

            UnfoldingOpts (..), defaultUnfoldingOpts,
            updateCreationThreshold, updateUseThreshold,
            updateFunAppDiscount, updateDictDiscount,
            updateVeryAggressive, updateCaseScaling, updateCaseThreshold,

            ArgSummary(..),

            couldBeSmallEnoughToInline, inlineBoringOk,
            certainlyWillInline, smallEnoughToInline,

            callSiteInline, CallCtxt(..),
            calcUnfoldingGuidance
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Driver.Session
    import GHC.Driver.Ppr
    import GHC.Core
    import GHC.Core.Utils
    import GHC.Types.Id
    import GHC.Types.Demand ( isDeadEndSig )
    import GHC.Core.DataCon
    import GHC.Types.Literal
    import GHC.Builtin.PrimOps
    import GHC.Types.Id.Info
    import GHC.Types.Basic  ( Arity, InlineSpec(..), inlinePragmaSpec )
    import GHC.Core.Type
    import GHC.Builtin.Names
    import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )
    import GHC.Data.Bag
    import GHC.Utils.Logger
    import GHC.Utils.Misc
    import GHC.Utils.Outputable
    import GHC.Types.ForeignCall
    import GHC.Types.Name
    import GHC.Types.Tickish

    import qualified Data.ByteString as BS
    import Data.List (isPrefixOf)

    -- | Unfolding options
    data UnfoldingOpts = UnfoldingOpts
       { UnfoldingOpts -> Int
    unfoldingCreationThreshold :: !Int
          -- ^ Threshold above which unfoldings are not *created*

       , UnfoldingOpts -> Int
    unfoldingUseThreshold :: !Int
          -- ^ Threshold above which unfoldings are not *inlined*

       , UnfoldingOpts -> Int
    unfoldingFunAppDiscount :: !Int
          -- ^ Discount for lambdas that are used (applied)

       , UnfoldingOpts -> Int
    unfoldingDictDiscount :: !Int
          -- ^ Discount for dictionaries

       , UnfoldingOpts -> Bool
    unfoldingVeryAggressive :: !Bool
          -- ^ Force inlining in many more cases

          -- Don't consider depth up to x
       , UnfoldingOpts -> Int
    unfoldingCaseThreshold :: !Int

          -- Penalize depth with 1/x
       , UnfoldingOpts -> Int
    unfoldingCaseScaling :: !Int
       }

    defaultUnfoldingOpts :: UnfoldingOpts
    defaultUnfoldingOpts :: UnfoldingOpts
    defaultUnfoldingOpts = UnfoldingOpts
       { unfoldingCreationThreshold :: Int
    unfoldingCreationThreshold = Int
    750
          -- The unfoldingCreationThreshold threshold must be reasonably high
          -- to take account of possible discounts.
          -- E.g. 450 is not enough in 'fulsom' for Interval.sqr to
          -- inline into Csg.calc (The unfolding for sqr never makes it
          -- into the interface file.)

       , unfoldingUseThreshold :: Int
    unfoldingUseThreshold   = Int
    90
          -- Last adjusted upwards in #18282, when I reduced
          -- the result discount for constructors.

       , unfoldingFunAppDiscount :: Int
    unfoldingFunAppDiscount = Int
    60
          -- Be fairly keen to inline a function if that means
          -- we'll be able to pick the right method from a dictionary

       , unfoldingDictDiscount :: Int
    unfoldingDictDiscount   = Int
    30
          -- Be fairly keen to inline a function if that means
          -- we'll be able to pick the right method from a dictionary

       , unfoldingVeryAggressive :: Bool
    unfoldingVeryAggressive = Bool
    False

          -- Only apply scaling once we are deeper than threshold cases
          -- in an RHS.
       , unfoldingCaseThreshold :: Int
    unfoldingCaseThreshold = Int
    2

          -- Penalize depth with (size*depth)/scaling
       , unfoldingCaseScaling :: Int
    unfoldingCaseScaling = Int
    30
       }

    -- Helpers for "GHC.Driver.Session"

    updateCreationThreshold :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateCreationThreshold :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateCreationThreshold Int
    n UnfoldingOpts
    opts = UnfoldingOpts
    opts { unfoldingCreationThreshold :: Int
    unfoldingCreationThreshold = Int
    n }

    updateUseThreshold :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateUseThreshold :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateUseThreshold Int
    n UnfoldingOpts
    opts = UnfoldingOpts
    opts { unfoldingUseThreshold :: Int
    unfoldingUseThreshold = Int
    n }

    updateFunAppDiscount :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateFunAppDiscount :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateFunAppDiscount Int
    n UnfoldingOpts
    opts = UnfoldingOpts
    opts { unfoldingFunAppDiscount :: Int
    unfoldingFunAppDiscount = Int
    n }

    updateDictDiscount :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateDictDiscount :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateDictDiscount Int
    n UnfoldingOpts
    opts = UnfoldingOpts
    opts { unfoldingDictDiscount :: Int
    unfoldingDictDiscount = Int
    n }

    updateVeryAggressive :: Bool -> UnfoldingOpts -> UnfoldingOpts
    updateVeryAggressive :: Bool -> UnfoldingOpts -> UnfoldingOpts
    updateVeryAggressive Bool
    n UnfoldingOpts
    opts = UnfoldingOpts
    opts { unfoldingVeryAggressive :: Bool
    unfoldingVeryAggressive = Bool
    n }

    updateCaseThreshold :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateCaseThreshold :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateCaseThreshold Int
    n UnfoldingOpts
    opts = UnfoldingOpts
    opts { unfoldingCaseThreshold :: Int
    unfoldingCaseThreshold = Int
    n }

    updateCaseScaling :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateCaseScaling :: Int -> UnfoldingOpts -> UnfoldingOpts
    updateCaseScaling Int
    n UnfoldingOpts
    opts = UnfoldingOpts
    opts { unfoldingCaseScaling :: Int
    unfoldingCaseScaling = Int
    n }

    {-
    Note [Occurrence analysis of unfoldings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We do occurrence-analysis of unfoldings once and for all, when the
    unfolding is built, rather than each time we inline them.

    But given this decision it's vital that we do
    *always* do it.  Consider this unfolding
        \x -> letrec { f = ...g...; g* = f } in body
    where g* is (for some strange reason) the loop breaker.  If we don't
    occ-anal it when reading it in, we won't mark g as a loop breaker, and
    we may inline g entirely in body, dropping its binding, and leaving
    the occurrence in f out of scope. This happened in #8892, where
    the unfolding in question was a DFun unfolding.

    But more generally, the simplifier is designed on the
    basis that it is looking at occurrence-analysed expressions, so better
    ensure that they actually are.

    Note [Calculate unfolding guidance on the non-occ-anal'd expression]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Notice that we give the non-occur-analysed expression to
    calcUnfoldingGuidance.  In some ways it'd be better to occur-analyse
    first; for example, sometimes during simplification, there's a large
    let-bound thing which has been substituted, and so is now dead; so
    'expr' contains two copies of the thing while the occurrence-analysed
    expression doesn't.

    Nevertheless, we *don't* and *must not* occ-analyse before computing
    the size because

    a) The size computation bales out after a while, whereas occurrence
       analysis does not.

    b) Residency increases sharply if you occ-anal first.  I'm not
       100% sure why, but it's a large effect.  Compiling Cabal went
       from residency of 534M to over 800M with this one change.

    This can occasionally mean that the guidance is very pessimistic;
    it gets fixed up next round.  And it should be rare, because large
    let-bound things that are dead are usually caught by preInlineUnconditionally

    ************************************************************************
    *                                                                      *
    \subsection{The UnfoldingGuidance type}
    *                                                                      *
    ************************************************************************
    -}

    inlineBoringOk :: CoreExpr -> Bool
    -- See Note [INLINE for small functions]
    -- True => the result of inlining the expression is
    --         no bigger than the expression itself
    --     eg      (\x y -> f y x)
    -- This is a quick and dirty version. It doesn't attempt
    -- to deal with  (\x y z -> x (y z))
    -- The really important one is (x `cast` c)
    inlineBoringOk :: CoreExpr -> Bool
    inlineBoringOk CoreExpr
    e
      = Int -> CoreExpr -> Bool
    go Int
    0 CoreExpr
    e
      where
        go :: Int -> CoreExpr -> Bool
        go :: Int -> CoreExpr -> Bool
    go Int
    credit (Lam Id
    x CoreExpr
    e) | Id -> Bool
    isId Id
    x           = Int -> CoreExpr -> Bool
    go (Int
    creditInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) CoreExpr
    e
                            | Bool
    otherwise        = Int -> CoreExpr -> Bool
    go Int
    credit CoreExpr
    e
            -- See Note [Count coercion arguments in boring contexts]
        go Int
    credit (App CoreExpr
    f (Type {}))            = Int -> CoreExpr -> Bool
    go Int
    credit CoreExpr
    f
        go Int
    credit (App CoreExpr
    f CoreExpr
    a) | Int
    credit Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                            , CoreExpr -> Bool
    exprIsTrivial CoreExpr
    a  = Int -> CoreExpr -> Bool
    go (Int
    creditInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) CoreExpr
    f
        go Int
    credit (Tick CoreTickish
    _ CoreExpr
    e)                   = Int -> CoreExpr -> Bool
    go Int
    credit CoreExpr
    e -- dubious
        go Int
    credit (Cast CoreExpr
    e CoercionR
    _)                   = Int -> CoreExpr -> Bool
    go Int
    credit CoreExpr
    e
        go Int
    credit (Case CoreExpr
    scrut Id
    _ Type
    _ [Alt AltCon
    _ [Id]
    _ CoreExpr
    rhs]) -- See Note [Inline unsafeCoerce]
          | CoreExpr -> Bool
    isUnsafeEqualityProof CoreExpr
    scrut        = Int -> CoreExpr -> Bool
    go Int
    credit CoreExpr
    rhs
        go Int
    _      (Var {})                     = Bool
    boringCxtOk
        go Int
    _      CoreExpr
    _                            = Bool
    boringCxtNotOk

    calcUnfoldingGuidance
            :: UnfoldingOpts
            -> Bool          -- Definitely a top-level, bottoming binding
            -> CoreExpr      -- Expression to look at
            -> UnfoldingGuidance
    calcUnfoldingGuidance :: UnfoldingOpts -> Bool -> CoreExpr -> UnfoldingGuidance
    calcUnfoldingGuidance UnfoldingOpts
    opts Bool
    is_top_bottoming (Tick CoreTickish
    t CoreExpr
    expr)
      | Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishIsCode CoreTickish
    t)  -- non-code ticks don't matter for unfolding
      = UnfoldingOpts -> Bool -> CoreExpr -> UnfoldingGuidance
    calcUnfoldingGuidance UnfoldingOpts
    opts Bool
    is_top_bottoming CoreExpr
    expr
    calcUnfoldingGuidance UnfoldingOpts
    opts Bool
    is_top_bottoming CoreExpr
    expr
      = case UnfoldingOpts -> Int -> [Id] -> CoreExpr -> ExprSize
    sizeExpr UnfoldingOpts
    opts Int
    bOMB_OUT_SIZE [Id]
    val_bndrs CoreExpr
    body of
          ExprSize
    TooBig -> UnfoldingGuidance
    UnfNever
          SizeIs Int
    size Bag (Id, Int)
    cased_bndrs Int
    scrut_discount
            | CoreExpr -> Int -> Int -> Bool
    uncondInline CoreExpr
    expr Int
    n_val_bndrs Int
    size
            -> UnfWhen { ug_unsat_ok :: Bool
    ug_unsat_ok = Bool
    unSaturatedOk
                       , ug_boring_ok :: Bool
    ug_boring_ok =  Bool
    boringCxtOk
                       , ug_arity :: Int
    ug_arity = Int
    n_val_bndrs }   -- Note [INLINE for small functions]

            | Bool
    is_top_bottoming
            -> UnfoldingGuidance
    UnfNever   -- See Note [Do not inline top-level bottoming functions]

            | Bool
    otherwise
            -> UnfIfGoodArgs { ug_args :: [Int]
    ug_args  = (Id -> Int) -> [Id] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bag (Id, Int) -> Id -> Int
    mk_discount Bag (Id, Int)
    cased_bndrs) [Id]
    val_bndrs
                             , ug_size :: Int
    ug_size  = Int
    size
                             , ug_res :: Int
    ug_res   = Int
    scrut_discount }

      where
        ([Id]
    bndrs, CoreExpr
    body) = CoreExpr -> ([Id], CoreExpr)
    forall b. Expr b -> ([b], Expr b)
    collectBinders CoreExpr
    expr
        bOMB_OUT_SIZE :: Int
    bOMB_OUT_SIZE = UnfoldingOpts -> Int
    unfoldingCreationThreshold UnfoldingOpts
    opts
               -- Bomb out if size gets bigger than this
        val_bndrs :: [Id]
    val_bndrs   = (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Id -> Bool
    isId [Id]
    bndrs
        n_val_bndrs :: Int
    n_val_bndrs = [Id] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Id]
    val_bndrs

        mk_discount :: Bag (Id,Int) -> Id -> Int
        mk_discount :: Bag (Id, Int) -> Id -> Int
    mk_discount Bag (Id, Int)
    cbs Id
    bndr = (Int -> (Id, Int) -> Int) -> Int -> Bag (Id, Int) -> Int
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Int -> (Id, Int) -> Int
    combine Int
    0 Bag (Id, Int)
    cbs
               where
                 combine :: Int -> (Id, Int) -> Int
    combine Int
    acc (Id
    bndr', Int
    disc)
                   | Id
    bndr Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    bndr' = Int
    acc Int -> Int -> Int
    `plus_disc` Int
    disc
                   | Bool
    otherwise     = Int
    acc

                 plus_disc :: Int -> Int -> Int
                 plus_disc :: Int -> Int -> Int
    plus_disc | Type -> Bool
    isFunTy (Id -> Type
    idType Id
    bndr) = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max
                           | Bool
    otherwise             = Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+)
                 -- See Note [Function and non-function discounts]

    {- Note [Inline unsafeCoerce]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We really want to inline unsafeCoerce, even when applied to boring
    arguments.  It doesn't look as if its RHS is smaller than the call
       unsafeCoerce x = case unsafeEqualityProof @a @b of UnsafeRefl -> x
    but that case is discarded -- see Note [Implementing unsafeCoerce]
    in base:Unsafe.Coerce.

    Moreover, if we /don't/ inline it, we may be left with
              f (unsafeCoerce x)
    which will build a thunk -- bad, bad, bad.

    Conclusion: we really want inlineBoringOk to be True of the RHS of
    unsafeCoerce.  This is (U4) in Note [Implementing unsafeCoerce].

    Note [Computing the size of an expression]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The basic idea of sizeExpr is obvious enough: count nodes.  But getting the
    heuristics right has taken a long time.  Here's the basic strategy:

        * Variables, literals: 0
          (Exception for string literals, see litSize.)

        * Function applications (f e1 .. en): 1 + #value args

        * Constructor applications: 1, regardless of #args

        * Let(rec): 1 + size of components

        * Note, cast: 0

    Examples

      Size  Term
      --------------
        0     42#
        0     x
        0     True
        2     f x
        1     Just x
        4     f (g x)

    Notice that 'x' counts 0, while (f x) counts 2.  That's deliberate: there's
    a function call to account for.  Notice also that constructor applications
    are very cheap, because exposing them to a caller is so valuable.

    [25/5/11] All sizes are now multiplied by 10, except for primops
    (which have sizes like 1 or 4.  This makes primops look fantastically
    cheap, and seems to be almost universally beneficial.  Done partly as a
    result of #4978.

    Note [Do not inline top-level bottoming functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The FloatOut pass has gone to some trouble to float out calls to 'error'
    and similar friends.  See Note [Bottoming floats] in GHC.Core.Opt.SetLevels.
    Do not re-inline them!  But we *do* still inline if they are very small
    (the uncondInline stuff).

    Note [INLINE for small functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider        {-# INLINE f #-}
                    f x = Just x
                    g y = f y
    Then f's RHS is no larger than its LHS, so we should inline it into
    even the most boring context.  In general, f the function is
    sufficiently small that its body is as small as the call itself, the
    inline unconditionally, regardless of how boring the context is.

    Things to note:

    (1) We inline *unconditionally* if inlined thing is smaller (using sizeExpr)
        than the thing it's replacing.  Notice that
          (f x) --> (g 3)             -- YES, unconditionally
          (f x) --> x : []            -- YES, *even though* there are two
                                      --      arguments to the cons
          x     --> g 3               -- NO
          x     --> Just v            -- NO

        It's very important not to unconditionally replace a variable by
        a non-atomic term.

    (2) We do this even if the thing isn't saturated, else we end up with the
        silly situation that
           f x y = x
           ...map (f 3)...
        doesn't inline.  Even in a boring context, inlining without being
        saturated will give a lambda instead of a PAP, and will be more
        efficient at runtime.

    (3) However, when the function's arity > 0, we do insist that it
        has at least one value argument at the call site.  (This check is
        made in the UnfWhen case of callSiteInline.) Otherwise we find this:
             f = /\a \x:a. x
             d = /\b. MkD (f b)
        If we inline f here we get
             d = /\b. MkD (\x:b. x)
        and then prepareRhs floats out the argument, abstracting the type
        variables, so we end up with the original again!

    (4) We must be much more cautious about arity-zero things. Consider
           let x = y +# z in ...
        In *size* terms primops look very small, because the generate a
        single instruction, but we do not want to unconditionally replace
        every occurrence of x with (y +# z).  So we only do the
        unconditional-inline thing for *trivial* expressions.

        NB: you might think that PostInlineUnconditionally would do this
        but it doesn't fire for top-level things; see GHC.Core.Opt.Simplify.Utils
        Note [Top level and postInlineUnconditionally]

    Note [Count coercion arguments in boring contexts]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In inlineBoringOK, we ignore type arguments when deciding whether an
    expression is okay to inline into boring contexts. This is good, since
    if we have a definition like

      let y = x @Int in f y y

    there’s no reason not to inline y at both use sites — no work is
    actually duplicated. It may seem like the same reasoning applies to
    coercion arguments, and indeed, in #17182 we changed inlineBoringOK to
    treat coercions the same way.

    However, this isn’t a good idea: unlike type arguments, which have
    no runtime representation, coercion arguments *do* have a runtime
    representation (albeit the zero-width VoidRep, see Note [Coercion tokens]
    in "GHC.CoreToStg"). This caused trouble in #17787 for DataCon wrappers for
    nullary GADT constructors: the wrappers would be inlined and each use of
    the constructor would lead to a separate allocation instead of just
    sharing the wrapper closure.

    The solution: don’t ignore coercion arguments after all.
    -}

    uncondInline :: CoreExpr -> Arity -> Int -> Bool
    -- Inline unconditionally if there no size increase
    -- Size of call is arity (+1 for the function)
    -- See Note [INLINE for small functions]
    uncondInline :: CoreExpr -> Int -> Int -> Bool
    uncondInline CoreExpr
    rhs Int
    arity Int
    size
      | Int
    arity Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 = Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    arity Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) -- See Note [INLINE for small functions] (1)
      | Bool
    otherwise = CoreExpr -> Bool
    exprIsTrivial CoreExpr
    rhs        -- See Note [INLINE for small functions] (4)

    sizeExpr :: UnfoldingOpts
             -> Int             -- Bomb out if it gets bigger than this
             -> [Id]            -- Arguments; we're interested in which of these
                                -- get case'd
             -> CoreExpr
             -> ExprSize

    -- Note [Computing the size of an expression]

    -- Forcing bOMB_OUT_SIZE early prevents repeated
    -- unboxing of the Int argument.
    sizeExpr :: UnfoldingOpts -> Int -> [Id] -> CoreExpr -> ExprSize
    sizeExpr UnfoldingOpts
    opts !Int
    bOMB_OUT_SIZE [Id]
    top_args CoreExpr
    expr
      = CoreExpr -> ExprSize
    size_up CoreExpr
    expr
      where
        size_up :: CoreExpr -> ExprSize
    size_up (Cast CoreExpr
    e CoercionR
    _) = CoreExpr -> ExprSize
    size_up CoreExpr
    e
        size_up (Tick CoreTickish
    _ CoreExpr
    e) = CoreExpr -> ExprSize
    size_up CoreExpr
    e
        size_up (Type Type
    _)   = ExprSize
    sizeZero           -- Types cost nothing
        size_up (Coercion CoercionR
    _) = ExprSize
    sizeZero
        size_up (Lit Literal
    lit)  = Int -> ExprSize
    sizeN (Literal -> Int
    litSize Literal
    lit)
        size_up (Var Id
    f) | Id -> Bool
    isRealWorldId Id
    f = ExprSize
    sizeZero
                          -- Make sure we get constructor discounts even
                          -- on nullary constructors
                        | Bool
    otherwise       = Id -> [CoreExpr] -> Int -> ExprSize
    size_up_call Id
    f [] Int
    0

        size_up (App CoreExpr
    fun CoreExpr
    arg)
          | CoreExpr -> Bool
    forall b. Expr b -> Bool
    isTyCoArg CoreExpr
    arg = CoreExpr -> ExprSize
    size_up CoreExpr
    fun
          | Bool
    otherwise     = CoreExpr -> ExprSize
    size_up CoreExpr
    arg  ExprSize -> ExprSize -> ExprSize
    `addSizeNSD`
                            CoreExpr -> [CoreExpr] -> Int -> ExprSize
    size_up_app CoreExpr
    fun [CoreExpr
    arg] (if CoreExpr -> Bool
    forall b. Expr b -> Bool
    isRealWorldExpr CoreExpr
    arg then Int
    1 else Int
    0)

        size_up (Lam Id
    b CoreExpr
    e)
          | Id -> Bool
    isId Id
    b Bool -> Bool -> Bool
    && Bool -> Bool
    not (Id -> Bool
    isRealWorldId Id
    b) = UnfoldingOpts -> ExprSize -> ExprSize
    lamScrutDiscount UnfoldingOpts
    opts (CoreExpr -> ExprSize
    size_up CoreExpr
    e ExprSize -> Int -> ExprSize
    `addSizeN` Int
    10)
          | Bool
    otherwise = CoreExpr -> ExprSize
    size_up CoreExpr
    e

        size_up (Let (NonRec Id
    binder CoreExpr
    rhs) CoreExpr
    body)
          = (Id, CoreExpr) -> ExprSize
    size_up_rhs (Id
    binder, CoreExpr
    rhs) ExprSize -> ExprSize -> ExprSize
    `addSizeNSD`
            CoreExpr -> ExprSize
    size_up CoreExpr
    body              ExprSize -> Int -> ExprSize
    `addSizeN`
            Id -> Int
    forall {a}. Num a => Id -> a
    size_up_alloc Id
    binder

        size_up (Let (Rec [(Id, CoreExpr)]
    pairs) CoreExpr
    body)
          = ((Id, CoreExpr) -> ExprSize -> ExprSize)
    -> ExprSize -> [(Id, CoreExpr)] -> ExprSize
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (ExprSize -> ExprSize -> ExprSize
    addSizeNSD (ExprSize -> ExprSize -> ExprSize)
    -> ((Id, CoreExpr) -> ExprSize)
    -> (Id, CoreExpr)
    -> ExprSize
    -> ExprSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Id, CoreExpr) -> ExprSize
    size_up_rhs)
                  (CoreExpr -> ExprSize
    size_up CoreExpr
    body ExprSize -> Int -> ExprSize
    `addSizeN` [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum (((Id, CoreExpr) -> Int) -> [(Id, CoreExpr)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id -> Int
    forall {a}. Num a => Id -> a
    size_up_alloc (Id -> Int) -> ((Id, CoreExpr) -> Id) -> (Id, CoreExpr) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Id, CoreExpr) -> Id
    forall a b. (a, b) -> a
    fst) [(Id, CoreExpr)]
    pairs))
                  [(Id, CoreExpr)]
    pairs

        size_up (Case CoreExpr
    e Id
    _ Type
    _ [Alt Id]
    alts)
            | [Alt Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Id]
    alts
            = CoreExpr -> ExprSize
    size_up CoreExpr
    e    -- case e of {} never returns, so take size of scrutinee

        size_up (Case CoreExpr
    e Id
    _ Type
    _ [Alt Id]
    alts)
            -- Now alts is non-empty
            | Just Id
    v <- CoreExpr -> Maybe Id
    is_top_arg CoreExpr
    e -- We are scrutinising an argument variable
            = let
                alt_sizes :: [ExprSize]
    alt_sizes = (Alt Id -> ExprSize) -> [Alt Id] -> [ExprSize]
    forall a b. (a -> b) -> [a] -> [b]
    map Alt Id -> ExprSize
    size_up_alt [Alt Id]
    alts

                      -- alts_size tries to compute a good discount for
                      -- the case when we are scrutinising an argument variable
                alts_size :: ExprSize -> ExprSize -> ExprSize
    alts_size (SizeIs Int
    tot Bag (Id, Int)
    tot_disc Int
    tot_scrut)
                              -- Size of all alternatives
                          (SizeIs Int
    max Bag (Id, Int)
    _        Int
    _)
                              -- Size of biggest alternative
                      = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    tot ((Id, Int) -> Bag (Id, Int)
    forall a. a -> Bag a
    unitBag (Id
    v, Int
    20 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    tot Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    max)
                          Bag (Id, Int) -> Bag (Id, Int) -> Bag (Id, Int)
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag (Id, Int)
    tot_disc) Int
    tot_scrut
                              -- If the variable is known, we produce a
                              -- discount that will take us back to 'max',
                              -- the size of the largest alternative The
                              -- 1+ is a little discount for reduced
                              -- allocation in the caller
                              --
                              -- Notice though, that we return tot_disc,
                              -- the total discount from all branches.  I
                              -- think that's right.

                alts_size ExprSize
    tot_size ExprSize
    _ = ExprSize
    tot_size
              in
              ExprSize -> ExprSize -> ExprSize
    alts_size ((ExprSize -> ExprSize -> ExprSize) -> [ExprSize] -> ExprSize
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 ExprSize -> ExprSize -> ExprSize
    addAltSize [ExprSize]
    alt_sizes)  -- alts is non-empty
                        ((ExprSize -> ExprSize -> ExprSize) -> [ExprSize] -> ExprSize
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 ExprSize -> ExprSize -> ExprSize
    maxSize    [ExprSize]
    alt_sizes)
                    -- Good to inline if an arg is scrutinised, because
                    -- that may eliminate allocation in the caller
                    -- And it eliminates the case itself
            where
              is_top_arg :: CoreExpr -> Maybe Id
    is_top_arg (Var Id
    v) | Id
    v Id -> [Id] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Id]
    top_args = Id -> Maybe Id
    forall a. a -> Maybe a
    Just Id
    v
              is_top_arg (Cast CoreExpr
    e CoercionR
    _) = CoreExpr -> Maybe Id
    is_top_arg CoreExpr
    e
              is_top_arg CoreExpr
    _ = Maybe Id
    forall a. Maybe a
    Nothing

        size_up (Case CoreExpr
    e Id
    _ Type
    _ [Alt Id]
    alts) = CoreExpr -> ExprSize
    size_up CoreExpr
    e  ExprSize -> ExprSize -> ExprSize
    `addSizeNSD`
                                    (Alt Id -> ExprSize -> ExprSize)
    -> ExprSize -> [Alt Id] -> ExprSize
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (ExprSize -> ExprSize -> ExprSize
    addAltSize (ExprSize -> ExprSize -> ExprSize)
    -> (Alt Id -> ExprSize) -> Alt Id -> ExprSize -> ExprSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Alt Id -> ExprSize
    size_up_alt) ExprSize
    case_size [Alt Id]
    alts
          where
              case_size :: ExprSize
    case_size
               | CoreExpr -> Bool
    forall b. Expr b -> Bool
    is_inline_scrut CoreExpr
    e, [Alt Id] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    lengthAtMost [Alt Id]
    alts Int
    1 = Int -> ExprSize
    sizeN (-Int
    10)
               | Bool
    otherwise = ExprSize
    sizeZero
                    -- Normally we don't charge for the case itself, but
                    -- we charge one per alternative (see size_up_alt,
                    -- below) to account for the cost of the info table
                    -- and comparisons.
                    --
                    -- However, in certain cases (see is_inline_scrut
                    -- below), no code is generated for the case unless
                    -- there are multiple alts.  In these cases we
                    -- subtract one, making the first alt free.
                    -- e.g. case x# +# y# of _ -> ...   should cost 1
                    --      case touch# x# of _ -> ...  should cost 0
                    -- (see #4978)
                    --
                    -- I would like to not have the "lengthAtMost alts 1"
                    -- condition above, but without that some programs got worse
                    -- (spectral/hartel/event and spectral/para).  I don't fully
                    -- understand why. (SDM 24/5/11)

                    -- unboxed variables, inline primops and unsafe foreign calls
                    -- are all "inline" things:
              is_inline_scrut :: Expr b -> Bool
    is_inline_scrut (Var Id
    v) = HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType (Id -> Type
    idType Id
    v)
              is_inline_scrut Expr b
    scrut
                  | (Var Id
    f, [Expr b]
    _) <- Expr b -> (Expr b, [Expr b])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs Expr b
    scrut
                    = case Id -> IdDetails
    idDetails Id
    f of
                        FCallId ForeignCall
    fc  -> Bool -> Bool
    not (ForeignCall -> Bool
    isSafeForeignCall ForeignCall
    fc)
                        PrimOpId PrimOp
    op -> Bool -> Bool
    not (PrimOp -> Bool
    primOpOutOfLine PrimOp
    op)
                        IdDetails
    _other      -> Bool
    False
                  | Bool
    otherwise
                    = Bool
    False

        size_up_rhs :: (Id, CoreExpr) -> ExprSize
    size_up_rhs (Id
    bndr, CoreExpr
    rhs)
          | Just Int
    join_arity <- Id -> Maybe Int
    isJoinId_maybe Id
    bndr
            -- Skip arguments to join point
          , ([Id]
    _bndrs, CoreExpr
    body) <- Int -> CoreExpr -> ([Id], CoreExpr)
    forall b. Int -> Expr b -> ([b], Expr b)
    collectNBinders Int
    join_arity CoreExpr
    rhs
          = CoreExpr -> ExprSize
    size_up CoreExpr
    body
          | Bool
    otherwise
          = CoreExpr -> ExprSize
    size_up CoreExpr
    rhs

        ------------
        -- size_up_app is used when there's ONE OR MORE value args
        size_up_app :: CoreExpr -> [CoreExpr] -> Int -> ExprSize
    size_up_app (App CoreExpr
    fun CoreExpr
    arg) [CoreExpr]
    args Int
    voids
            | CoreExpr -> Bool
    forall b. Expr b -> Bool
    isTyCoArg CoreExpr
    arg                  = CoreExpr -> [CoreExpr] -> Int -> ExprSize
    size_up_app CoreExpr
    fun [CoreExpr]
    args Int
    voids
            | CoreExpr -> Bool
    forall b. Expr b -> Bool
    isRealWorldExpr CoreExpr
    arg            = CoreExpr -> [CoreExpr] -> Int -> ExprSize
    size_up_app CoreExpr
    fun (CoreExpr
    argCoreExpr -> [CoreExpr] -> [CoreExpr]
    forall a. a -> [a] -> [a]
    :[CoreExpr]
    args) (Int
    voids Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            | Bool
    otherwise                      = CoreExpr -> ExprSize
    size_up CoreExpr
    arg  ExprSize -> ExprSize -> ExprSize
    `addSizeNSD`
                                               CoreExpr -> [CoreExpr] -> Int -> ExprSize
    size_up_app CoreExpr
    fun (CoreExpr
    argCoreExpr -> [CoreExpr] -> [CoreExpr]
    forall a. a -> [a] -> [a]
    :[CoreExpr]
    args) Int
    voids
        size_up_app (Var Id
    fun)     [CoreExpr]
    args Int
    voids = Id -> [CoreExpr] -> Int -> ExprSize
    size_up_call Id
    fun [CoreExpr]
    args Int
    voids
        size_up_app (Tick CoreTickish
    _ CoreExpr
    expr) [CoreExpr]
    args Int
    voids = CoreExpr -> [CoreExpr] -> Int -> ExprSize
    size_up_app CoreExpr
    expr [CoreExpr]
    args Int
    voids
        size_up_app (Cast CoreExpr
    expr CoercionR
    _) [CoreExpr]
    args Int
    voids = CoreExpr -> [CoreExpr] -> Int -> ExprSize
    size_up_app CoreExpr
    expr [CoreExpr]
    args Int
    voids
        size_up_app CoreExpr
    other         [CoreExpr]
    args Int
    voids = CoreExpr -> ExprSize
    size_up CoreExpr
    other ExprSize -> Int -> ExprSize
    `addSizeN`
                                               Int -> Int -> Int
    callSize ([CoreExpr] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    args) Int
    voids
           -- if the lhs is not an App or a Var, or an invisible thing like a
           -- Tick or Cast, then we should charge for a complete call plus the
           -- size of the lhs itself.

        ------------
        size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize
        size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize
    size_up_call Id
    fun [CoreExpr]
    val_args Int
    voids
           = case Id -> IdDetails
    idDetails Id
    fun of
               FCallId ForeignCall
    _        -> Int -> ExprSize
    sizeN (Int -> Int -> Int
    callSize ([CoreExpr] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    val_args) Int
    voids)
               DataConWorkId DataCon
    dc -> DataCon -> Int -> ExprSize
    conSize    DataCon
    dc ([CoreExpr] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    val_args)
               PrimOpId PrimOp
    op      -> PrimOp -> Int -> ExprSize
    primOpSize PrimOp
    op ([CoreExpr] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    val_args)
               ClassOpId Class
    _      -> UnfoldingOpts -> [Id] -> [CoreExpr] -> ExprSize
    classOpSize UnfoldingOpts
    opts [Id]
    top_args [CoreExpr]
    val_args
               IdDetails
    _                -> UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize
    funSize UnfoldingOpts
    opts [Id]
    top_args Id
    fun ([CoreExpr] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    val_args) Int
    voids

        ------------
        size_up_alt :: Alt Id -> ExprSize
    size_up_alt (Alt AltCon
    _con [Id]
    _bndrs CoreExpr
    rhs) = CoreExpr -> ExprSize
    size_up CoreExpr
    rhs ExprSize -> Int -> ExprSize
    `addSizeN` Int
    10
            -- Don't charge for args, so that wrappers look cheap
            -- (See comments about wrappers with Case)
            --
            -- IMPORTANT: *do* charge 1 for the alternative, else we
            -- find that giant case nests are treated as practically free
            -- A good example is Foreign.C.Error.errnoToIOError

        ------------
        -- Cost to allocate binding with given binder
        size_up_alloc :: Id -> a
    size_up_alloc Id
    bndr
          |  Id -> Bool
    isTyVar Id
    bndr                 -- Doesn't exist at runtime
          Bool -> Bool -> Bool
    || Id -> Bool
    isJoinId Id
    bndr                -- Not allocated at all
          Bool -> Bool -> Bool
    || HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType (Id -> Type
    idType Id
    bndr) -- Doesn't live in heap
          = a
    0
          | Bool
    otherwise
          = a
    10

        ------------
            -- These addSize things have to be here because
            -- I don't want to give them bOMB_OUT_SIZE as an argument
        addSizeN :: ExprSize -> Int -> ExprSize
    addSizeN ExprSize
    TooBig          Int
    _  = ExprSize
    TooBig
        addSizeN (SizeIs Int
    n Bag (Id, Int)
    xs Int
    d) Int
    m  = Int -> Int -> Bag (Id, Int) -> Int -> ExprSize
    mkSizeIs Int
    bOMB_OUT_SIZE (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    m) Bag (Id, Int)
    xs Int
    d

            -- addAltSize is used to add the sizes of case alternatives
        addAltSize :: ExprSize -> ExprSize -> ExprSize
    addAltSize ExprSize
    TooBig            ExprSize
    _      = ExprSize
    TooBig
        addAltSize ExprSize
    _                 ExprSize
    TooBig = ExprSize
    TooBig
        addAltSize (SizeIs Int
    n1 Bag (Id, Int)
    xs Int
    d1) (SizeIs Int
    n2 Bag (Id, Int)
    ys Int
    d2)
            = Int -> Int -> Bag (Id, Int) -> Int -> ExprSize
    mkSizeIs Int
    bOMB_OUT_SIZE (Int
    n1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n2)
                                     (Bag (Id, Int)
    xs Bag (Id, Int) -> Bag (Id, Int) -> Bag (Id, Int)
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag (Id, Int)
    ys)
                                     (Int
    d1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    d2) -- Note [addAltSize result discounts]

            -- This variant ignores the result discount from its LEFT argument
            -- It's used when the second argument isn't part of the result
        addSizeNSD :: ExprSize -> ExprSize -> ExprSize
    addSizeNSD ExprSize
    TooBig            ExprSize
    _      = ExprSize
    TooBig
        addSizeNSD ExprSize
    _                 ExprSize
    TooBig = ExprSize
    TooBig
        addSizeNSD (SizeIs Int
    n1 Bag (Id, Int)
    xs Int
    _) (SizeIs Int
    n2 Bag (Id, Int)
    ys Int
    d2)
            = Int -> Int -> Bag (Id, Int) -> Int -> ExprSize
    mkSizeIs Int
    bOMB_OUT_SIZE (Int
    n1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n2)
                                     (Bag (Id, Int)
    xs Bag (Id, Int) -> Bag (Id, Int) -> Bag (Id, Int)
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag (Id, Int)
    ys)
                                     Int
    d2  -- Ignore d1

        isRealWorldId :: Id -> Bool
    isRealWorldId Id
    id = Id -> Type
    idType Id
    id Type -> Type -> Bool
    `eqType` Type
    realWorldStatePrimTy

        -- an expression of type State# RealWorld must be a variable
        isRealWorldExpr :: Expr b -> Bool
    isRealWorldExpr (Var Id
    id)   = Id -> Bool
    isRealWorldId Id
    id
        isRealWorldExpr (Tick CoreTickish
    _ Expr b
    e) = Expr b -> Bool
    isRealWorldExpr Expr b
    e
        isRealWorldExpr Expr b
    _          = Bool
    False

    -- | Finds a nominal size of a string literal.
    litSize :: Literal -> Int
    -- Used by GHC.Core.Unfold.sizeExpr
    litSize :: Literal -> Int
    litSize (LitNumber LitNumType
    LitNumInteger Integer
    _) = Int
    100   -- Note [Size of literal integers]
    litSize (LitNumber LitNumType
    LitNumNatural Integer
    _) = Int
    100
    litSize (LitString ByteString
    str) = Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * ((ByteString -> Int
    BS.length ByteString
    str Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    4)
            -- If size could be 0 then @f "x"@ might be too small
            -- [Sept03: make literal strings a bit bigger to avoid fruitless
            --  duplication of little strings]
    litSize Literal
    _other = Int
    0    -- Must match size of nullary constructors
                          -- Key point: if  x |-> 4, then x must inline unconditionally
                          --            (eg via case binding)

    classOpSize :: UnfoldingOpts -> [Id] -> [CoreExpr] -> ExprSize
    -- See Note [Conlike is interesting]
    classOpSize :: UnfoldingOpts -> [Id] -> [CoreExpr] -> ExprSize
    classOpSize UnfoldingOpts
    _ [Id]
    _ []
      = ExprSize
    sizeZero
    classOpSize UnfoldingOpts
    opts [Id]
    top_args (CoreExpr
    arg1 : [CoreExpr]
    other_args)
      = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    size Bag (Id, Int)
    arg_discount Int
    0
      where
        size :: Int
    size = Int
    20 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [CoreExpr] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    other_args)
        -- If the class op is scrutinising a lambda bound dictionary then
        -- give it a discount, to encourage the inlining of this function
        -- The actual discount is rather arbitrarily chosen
        arg_discount :: Bag (Id, Int)
    arg_discount = case CoreExpr
    arg1 of
                         Var Id
    dict | Id
    dict Id -> [Id] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Id]
    top_args
                                  -> (Id, Int) -> Bag (Id, Int)
    forall a. a -> Bag a
    unitBag (Id
    dict, UnfoldingOpts -> Int
    unfoldingDictDiscount UnfoldingOpts
    opts)
                         CoreExpr
    _other   -> Bag (Id, Int)
    forall a. Bag a
    emptyBag

    -- | The size of a function call
    callSize
     :: Int  -- ^ number of value args
     -> Int  -- ^ number of value args that are void
     -> Int
    callSize :: Int -> Int -> Int
    callSize Int
    n_val_args Int
    voids = Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n_val_args Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    voids)
            -- The 1+ is for the function itself
            -- Add 1 for each non-trivial arg;
            -- the allocation cost, as in let(rec)

    -- | The size of a jump to a join point
    jumpSize
     :: Int  -- ^ number of value args
     -> Int  -- ^ number of value args that are void
     -> Int
    jumpSize :: Int -> Int -> Int
    jumpSize Int
    n_val_args Int
    voids = Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n_val_args Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    voids)
      -- A jump is 20% the size of a function call. Making jumps free reopens
      -- bug #6048, but making them any more expensive loses a 21% improvement in
      -- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a
      -- better solution?

    funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize
    -- Size for functions that are not constructors or primops
    -- Note [Function applications]
    funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize
    funSize UnfoldingOpts
    opts [Id]
    top_args Id
    fun Int
    n_val_args Int
    voids
      | Id
    fun Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    buildIdKey   = ExprSize
    buildSize
      | Id
    fun Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    augmentIdKey = ExprSize
    augmentSize
      | Bool
    otherwise = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    size Bag (Id, Int)
    arg_discount Int
    res_discount
      where
        some_val_args :: Bool
    some_val_args = Int
    n_val_args Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
        is_join :: Bool
    is_join = Id -> Bool
    isJoinId Id
    fun

        size :: Int
    size | Bool
    is_join              = Int -> Int -> Int
    jumpSize Int
    n_val_args Int
    voids
             | Bool -> Bool
    not Bool
    some_val_args    = Int
    0
             | Bool
    otherwise            = Int -> Int -> Int
    callSize Int
    n_val_args Int
    voids

            --                  DISCOUNTS
            --  See Note [Function and non-function discounts]
        arg_discount :: Bag (Id, Int)
    arg_discount | Bool
    some_val_args Bool -> Bool -> Bool
    && Id
    fun Id -> [Id] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Id]
    top_args
                     = (Id, Int) -> Bag (Id, Int)
    forall a. a -> Bag a
    unitBag (Id
    fun, UnfoldingOpts -> Int
    unfoldingFunAppDiscount UnfoldingOpts
    opts)
                     | Bool
    otherwise = Bag (Id, Int)
    forall a. Bag a
    emptyBag
            -- If the function is an argument and is applied
            -- to some values, give it an arg-discount

        res_discount :: Int
    res_discount | Id -> Int
    idArity Id
    fun Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    n_val_args = UnfoldingOpts -> Int
    unfoldingFunAppDiscount UnfoldingOpts
    opts
                     | Bool
    otherwise                = Int
    0
            -- If the function is partially applied, show a result discount
    -- XXX maybe behave like ConSize for eval'd variable

    conSize :: DataCon -> Int -> ExprSize
    conSize :: DataCon -> Int -> ExprSize
    conSize DataCon
    dc Int
    n_val_args
      | Int
    n_val_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    0 Bag (Id, Int)
    forall a. Bag a
    emptyBag Int
    10    -- Like variables

    -- See Note [Unboxed tuple size and result discount]
      | DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    dc = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    0 Bag (Id, Int)
    forall a. Bag a
    emptyBag Int
    10

    -- See Note [Constructor size and result discount]
      | Bool
    otherwise = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    10 Bag (Id, Int)
    forall a. Bag a
    emptyBag Int
    10

    {- Note [Constructor size and result discount]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Treat a constructors application as size 10, regardless of how many
    arguments it has; we are keen to expose them (and we charge separately
    for their args).  We can't treat them as size zero, else we find that
    (Just x) has size 0, which is the same as a lone variable; and hence
    'v' will always be replaced by (Just x), where v is bound to Just x.

    The "result discount" is applied if the result of the call is
    scrutinised (say by a case).  For a constructor application that will
    mean the constructor application will disappear, so we don't need to
    charge it to the function.  So the discount should at least match the
    cost of the constructor application, namely 10.

    Historical note 1: Until Jun 2020 we gave it a "bit of extra
    incentive" via a discount of 10*(1 + n_val_args), but that was FAR too
    much (#18282).  In particular, consider a huge case tree like

       let r = case y1 of
              Nothing -> B1 a b c
              Just v1 -> case y2 of
                          Nothing -> B1 c b a
                          Just v2 -> ...

    If conSize gives a cost of 10 (regardless of n_val_args) and a
    discount of 10, that'll make each alternative RHS cost zero.  We
    charge 10 for each case alternative (see size_up_alt).  If we give a
    bigger discount (say 20) in conSize, we'll make the case expression
    cost *nothing*, and that can make a huge case tree cost nothing. This
    leads to massive, sometimes exponenial inlinings (#18282).  In short,
    don't give a discount that give a negative size to a sub-expression!

    Historical note 2: Much longer ago, Simon M tried a MUCH bigger
    discount: (10 * (10 + n_val_args)), and said it was an "unambiguous
    win", but its terribly dangerous because a function with many many
    case branches, each finishing with a constructor, can have an
    arbitrarily large discount.  This led to terrible code bloat: see #6099.

    Note [Unboxed tuple size and result discount]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    However, unboxed tuples count as size zero. I found occasions where we had
            f x y z = case op# x y z of { s -> (# s, () #) }
    and f wasn't getting inlined.

    I tried giving unboxed tuples a *result discount* of zero (see the
    commented-out line).  Why?  When returned as a result they do not
    allocate, so maybe we don't want to charge so much for them. If you
    have a non-zero discount here, we find that workers often get inlined
    back into wrappers, because it look like
        f x = case $wf x of (# a,b #) -> (a,b)
    and we are keener because of the case.  However while this change
    shrank binary sizes by 0.5% it also made spectral/boyer allocate 5%
    more. All other changes were very small. So it's not a big deal but I
    didn't adopt the idea.

    When fixing #18282 (see Note [Constructor size and result discount])
    I changed the result discount to be just 10, not 10*(1+n_val_args).

    Note [Function and non-function discounts]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We want a discount if the function is applied. A good example is
    monadic combinators with continuation arguments, where inlining is
    quite important.

    But we don't want a big discount when a function is called many times
    (see the detailed comments with #6048) because if the function is
    big it won't be inlined at its many call sites and no benefit results.
    Indeed, we can get exponentially big inlinings this way; that is what
    #6048 is about.

    On the other hand, for data-valued arguments, if there are lots of
    case expressions in the body, each one will get smaller if we apply
    the function to a constructor application, so we *want* a big discount
    if the argument is scrutinised by many case expressions.

    Conclusion:
      - For functions, take the max of the discounts
      - For data values, take the sum of the discounts

    Note [Literal integer size]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Literal integers *can* be big (mkInteger [...coefficients...]), but
    need not be (IS n).  We just use an arbitrary big-ish constant here
    so that, in particular, we don't inline top-level defns like
       n = IS 5
    There's no point in doing so -- any optimisations will see the IS
    through n's unfolding.  Nor will a big size inhibit unfoldings functions
    that mention a literal Integer, because the float-out pass will float
    all those constants to top level.
    -}

    primOpSize :: PrimOp -> Int -> ExprSize
    primOpSize :: PrimOp -> Int -> ExprSize
    primOpSize PrimOp
    op Int
    n_val_args
     = if PrimOp -> Bool
    primOpOutOfLine PrimOp
    op
          then Int -> ExprSize
    sizeN (Int
    op_size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n_val_args)
          else Int -> ExprSize
    sizeN Int
    op_size
     where
       op_size :: Int
    op_size = PrimOp -> Int
    primOpCodeSize PrimOp
    op

    buildSize :: ExprSize
    buildSize :: ExprSize
    buildSize = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    0 Bag (Id, Int)
    forall a. Bag a
    emptyBag Int
    40
            -- We really want to inline applications of build
            -- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
            -- Indeed, we should add a result_discount because build is
            -- very like a constructor.  We don't bother to check that the
            -- build is saturated (it usually is).  The "-2" discounts for the \c n,
            -- The "4" is rather arbitrary.

    augmentSize :: ExprSize
    augmentSize :: ExprSize
    augmentSize = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    0 Bag (Id, Int)
    forall a. Bag a
    emptyBag Int
    40
            -- Ditto (augment t (\cn -> e) ys) should cost only the cost of
            -- e plus ys. The -2 accounts for the \cn

    -- When we return a lambda, give a discount if it's used (applied)
    lamScrutDiscount :: UnfoldingOpts -> ExprSize -> ExprSize
    lamScrutDiscount :: UnfoldingOpts -> ExprSize -> ExprSize
    lamScrutDiscount UnfoldingOpts
    opts (SizeIs Int
    n Bag (Id, Int)
    vs Int
    _) = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    n Bag (Id, Int)
    vs (UnfoldingOpts -> Int
    unfoldingFunAppDiscount UnfoldingOpts
    opts)
    lamScrutDiscount UnfoldingOpts
    _      ExprSize
    TooBig          = ExprSize
    TooBig

    {-
    Note [addAltSize result discounts]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When adding the size of alternatives, we *add* the result discounts
    too, rather than take the *maximum*.  For a multi-branch case, this
    gives a discount for each branch that returns a constructor, making us
    keener to inline.  I did try using 'max' instead, but it makes nofib
    'rewrite' and 'puzzle' allocate significantly more, and didn't make
    binary sizes shrink significantly either.

    Note [Discounts and thresholds]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Constants for discounts and thresholds are defined in 'UnfoldingOpts'. They are:

    unfoldingCreationThreshold
         At a definition site, if the unfolding is bigger than this, we
         may discard it altogether

    unfoldingUseThreshold
         At a call site, if the unfolding, less discounts, is smaller than
         this, then it's small enough inline

    unfoldingDictDiscount
         The discount for each occurrence of a dictionary argument
         as an argument of a class method.  Should be pretty small
         else big functions may get inlined

    unfoldingFunAppDiscount
         Discount for a function argument that is applied.  Quite
         large, because if we inline we avoid the higher-order call.

    unfoldingVeryAggressive
         If True, the compiler ignores all the thresholds and inlines very
         aggressively. It still adheres to arity, simplifier phase control and
         loop breakers.

    Historical Note: Before April 2020 we had another factor,
    ufKeenessFactor, which would scale the discounts before they were subtracted
    from the size. This was justified with the following comment:

      -- We multiply the raw discounts (args_discount and result_discount)
      -- ty opt_UnfoldingKeenessFactor because the former have to do with
      --  *size* whereas the discounts imply that there's some extra
      --  *efficiency* to be gained (e.g. beta reductions, case reductions)
      -- by inlining.

    However, this is highly suspect since it means that we subtract a *scaled* size
    from an absolute size, resulting in crazy (e.g. negative) scores in some cases
    (#15304). We consequently killed off ufKeenessFactor and bumped up the
    ufUseThreshold to compensate.

    Note [Function applications]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In a function application (f a b)

      - If 'f' is an argument to the function being analysed,
        and there's at least one value arg, record a FunAppDiscount for f

      - If the application if a PAP (arity > 2 in this example)
        record a *result* discount (because inlining
        with "extra" args in the call may mean that we now
        get a saturated application)

    Code for manipulating sizes
    -}

    -- | The size of a candidate expression for unfolding
    data ExprSize
        = TooBig
        | SizeIs { ExprSize -> Int
    _es_size_is  :: {-# UNPACK #-} !Int -- ^ Size found
                 , ExprSize -> Bag (Id, Int)
    _es_args     :: !(Bag (Id,Int))
                   -- ^ Arguments cased herein, and discount for each such
                 , ExprSize -> Int
    _es_discount :: {-# UNPACK #-} !Int
                   -- ^ Size to subtract if result is scrutinised by a case
                   -- expression
                 }

    instance Outputable ExprSize where
      ppr :: ExprSize -> SDoc
    ppr ExprSize
    TooBig         = String -> SDoc
    text String
    "TooBig"
      ppr (SizeIs Int
    a Bag (Id, Int)
    _ Int
    c) = SDoc -> SDoc
    brackets (Int -> SDoc
    int Int
    a SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    c)

    -- subtract the discount before deciding whether to bale out. eg. we
    -- want to inline a large constructor application into a selector:
    --      tup = (a_1, ..., a_99)
    --      x = case tup of ...
    --
    mkSizeIs :: Int -> Int -> Bag (Id, Int) -> Int -> ExprSize
    mkSizeIs :: Int -> Int -> Bag (Id, Int) -> Int -> ExprSize
    mkSizeIs Int
    max Int
    n Bag (Id, Int)
    xs Int
    d | (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    d) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    max = ExprSize
    TooBig
                        | Bool
    otherwise     = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    n Bag (Id, Int)
    xs Int
    d

    maxSize :: ExprSize -> ExprSize -> ExprSize
    maxSize :: ExprSize -> ExprSize -> ExprSize
    maxSize ExprSize
    TooBig         ExprSize
    _                                  = ExprSize
    TooBig
    maxSize ExprSize
    _              ExprSize
    TooBig                             = ExprSize
    TooBig
    maxSize s1 :: ExprSize
    s1@(SizeIs Int
    n1 Bag (Id, Int)
    _ Int
    _) s2 :: ExprSize
    s2@(SizeIs Int
    n2 Bag (Id, Int)
    _ Int
    _) | Int
    n1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    n2   = ExprSize
    s1
                                                  | Bool
    otherwise = ExprSize
    s2

    sizeZero :: ExprSize
    sizeN :: Int -> ExprSize

    sizeZero :: ExprSize
    sizeZero = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    0 Bag (Id, Int)
    forall a. Bag a
    emptyBag Int
    0
    sizeN :: Int -> ExprSize
    sizeN Int
    n  = Int -> Bag (Id, Int) -> Int -> ExprSize
    SizeIs Int
    n Bag (Id, Int)
    forall a. Bag a
    emptyBag Int
    0

    {-
    ************************************************************************
    *                                                                      *
    \subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}
    *                                                                      *
    ************************************************************************

    We use 'couldBeSmallEnoughToInline' to avoid exporting inlinings that
    we ``couldn't possibly use'' on the other side.  Can be overridden w/
    flaggery.  Just the same as smallEnoughToInline, except that it has no
    actual arguments.
    -}

    couldBeSmallEnoughToInline :: UnfoldingOpts -> Int -> CoreExpr -> Bool
    couldBeSmallEnoughToInline :: UnfoldingOpts -> Int -> CoreExpr -> Bool
    couldBeSmallEnoughToInline UnfoldingOpts
    opts Int
    threshold CoreExpr
    rhs
      = case UnfoldingOpts -> Int -> [Id] -> CoreExpr -> ExprSize
    sizeExpr UnfoldingOpts
    opts Int
    threshold [] CoreExpr
    body of
           ExprSize
    TooBig -> Bool
    False
           ExprSize
    _      -> Bool
    True
      where
        ([Id]
    _, CoreExpr
    body) = CoreExpr -> ([Id], CoreExpr)
    forall b. Expr b -> ([b], Expr b)
    collectBinders CoreExpr
    rhs

    ----------------
    smallEnoughToInline :: UnfoldingOpts -> Unfolding -> Bool
    smallEnoughToInline :: UnfoldingOpts -> Unfolding -> Bool
    smallEnoughToInline UnfoldingOpts
    opts (CoreUnfolding {uf_guidance :: Unfolding -> UnfoldingGuidance
    uf_guidance = UnfIfGoodArgs {ug_size :: UnfoldingGuidance -> Int
    ug_size = Int
    size}})
      = Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= UnfoldingOpts -> Int
    unfoldingUseThreshold UnfoldingOpts
    opts
    smallEnoughToInline UnfoldingOpts
    _ Unfolding
    _
      = Bool
    False

    ----------------

    certainlyWillInline :: UnfoldingOpts -> IdInfo -> Maybe Unfolding
    -- ^ Sees if the unfolding is pretty certain to inline.
    -- If so, return a *stable* unfolding for it, that will always inline.
    certainlyWillInline :: UnfoldingOpts -> IdInfo -> Maybe Unfolding
    certainlyWillInline UnfoldingOpts
    opts IdInfo
    fn_info
      = case Unfolding
    fn_unf of
          CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
    uf_tmpl = CoreExpr
    expr, uf_guidance :: Unfolding -> UnfoldingGuidance
    uf_guidance = UnfoldingGuidance
    guidance, uf_src :: Unfolding -> UnfoldingSource
    uf_src = UnfoldingSource
    src }
            | Bool
    loop_breaker -> Maybe Unfolding
    forall a. Maybe a
    Nothing       -- Won't inline, so try w/w
            | Bool
    noinline     -> Maybe Unfolding
    forall a. Maybe a
    Nothing       -- See Note [Worker-wrapper for NOINLINE functions]
            | Bool
    otherwise
            -> case UnfoldingGuidance
    guidance of
                 UnfoldingGuidance
    UnfNever  -> Maybe Unfolding
    forall a. Maybe a
    Nothing
                 UnfWhen {} -> Unfolding -> Maybe Unfolding
    forall a. a -> Maybe a
    Just (Unfolding
    fn_unf { uf_src :: UnfoldingSource
    uf_src = UnfoldingSource
    src' })
                                 -- INLINE functions have UnfWhen
                 UnfIfGoodArgs { ug_size :: UnfoldingGuidance -> Int
    ug_size = Int
    size, ug_args :: UnfoldingGuidance -> [Int]
    ug_args = [Int]
    args }
                   -> CoreExpr -> Int -> [Int] -> UnfoldingSource -> Maybe Unfolding
    do_cunf CoreExpr
    expr Int
    size [Int]
    args UnfoldingSource
    src'
            where
              src' :: UnfoldingSource
    src' = case UnfoldingSource
    src of
                       UnfoldingSource
    InlineRhs -> UnfoldingSource
    InlineStable
                       UnfoldingSource
    _         -> UnfoldingSource
    src  -- Do not change InlineCompulsory!

          DFunUnfolding {} -> Unfolding -> Maybe Unfolding
    forall a. a -> Maybe a
    Just Unfolding
    fn_unf  -- Don't w/w DFuns; it never makes sense
                                           -- to do so, and even if it is currently a
                                           -- loop breaker, it may not be later

          Unfolding
    _other_unf       -> Maybe Unfolding
    forall a. Maybe a
    Nothing

      where
        loop_breaker :: Bool
    loop_breaker = OccInfo -> Bool
    isStrongLoopBreaker (IdInfo -> OccInfo
    occInfo IdInfo
    fn_info)
        noinline :: Bool
    noinline     = InlinePragma -> InlineSpec
    inlinePragmaSpec (IdInfo -> InlinePragma
    inlinePragInfo IdInfo
    fn_info) InlineSpec -> InlineSpec -> Bool
    forall a. Eq a => a -> a -> Bool
    == InlineSpec
    NoInline
        fn_unf :: Unfolding
    fn_unf       = IdInfo -> Unfolding
    unfoldingInfo IdInfo
    fn_info

            -- The UnfIfGoodArgs case seems important.  If we w/w small functions
            -- binary sizes go up by 10%!  (This is with SplitObjs.)
            -- I'm not totally sure why.
            -- INLINABLE functions come via this path
            --    See Note [certainlyWillInline: INLINABLE]
        do_cunf :: CoreExpr -> Int -> [Int] -> UnfoldingSource -> Maybe Unfolding
    do_cunf CoreExpr
    expr Int
    size [Int]
    args UnfoldingSource
    src'
          | IdInfo -> Int
    arityInfo IdInfo
    fn_info Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0  -- See Note [certainlyWillInline: be careful of thunks]
          , Bool -> Bool
    not (StrictSig -> Bool
    isDeadEndSig (IdInfo -> StrictSig
    strictnessInfo IdInfo
    fn_info))
                  -- Do not unconditionally inline a bottoming functions even if
                  -- it seems smallish. We've carefully lifted it out to top level,
                  -- so we don't want to re-inline it.
          , let unf_arity :: Int
    unf_arity = [Int] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    args
          , Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    unf_arity Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= UnfoldingOpts -> Int
    unfoldingUseThreshold UnfoldingOpts
    opts
          = Unfolding -> Maybe Unfolding
    forall a. a -> Maybe a
    Just (Unfolding
    fn_unf { uf_src :: UnfoldingSource
    uf_src      = UnfoldingSource
    src'
                         , uf_guidance :: UnfoldingGuidance
    uf_guidance = UnfWhen { ug_arity :: Int
    ug_arity     = Int
    unf_arity
                                                 , ug_unsat_ok :: Bool
    ug_unsat_ok  = Bool
    unSaturatedOk
                                                 , ug_boring_ok :: Bool
    ug_boring_ok = CoreExpr -> Bool
    inlineBoringOk CoreExpr
    expr } })
                 -- Note the "unsaturatedOk". A function like  f = \ab. a
                 -- will certainly inline, even if partially applied (f e), so we'd
                 -- better make sure that the transformed inlining has the same property
          | Bool
    otherwise
          = Maybe Unfolding
    forall a. Maybe a
    Nothing

    {- Note [certainlyWillInline: be careful of thunks]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Don't claim that thunks will certainly inline, because that risks work
    duplication.  Even if the work duplication is not great (eg is_cheap
    holds), it can make a big difference in an inner loop In #5623 we
    found that the WorkWrap phase thought that
           y = case x of F# v -> F# (v +# v)
    was certainlyWillInline, so the addition got duplicated.

    Note that we check arityInfo instead of the arity of the unfolding to detect
    this case. This is so that we don't accidentally fail to inline small partial
    applications, like `f = g 42` (where `g` recurses into `f`) where g has arity 2
    (say). Here there is no risk of work duplication, and the RHS is tiny, so
    certainlyWillInline should return True. But `unf_arity` is zero! However f's
    arity, gotten from `arityInfo fn_info`, is 1.

    Failing to say that `f` will inline forces W/W to generate a potentially huge
    worker for f that will immediately cancel with `g`'s wrapper anyway, causing
    unnecessary churn in the Simplifier while arriving at the same result.

    Note [certainlyWillInline: INLINABLE]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    certainlyWillInline /must/ return Nothing for a large INLINABLE thing,
    even though we have a stable inlining, so that strictness w/w takes
    place.  It makes a big difference to efficiency, and the w/w pass knows
    how to transfer the INLINABLE info to the worker; see WorkWrap
    Note [Worker-wrapper for INLINABLE functions]

    ************************************************************************
    *                                                                      *
    \subsection{callSiteInline}
    *                                                                      *
    ************************************************************************

    This is the key function.  It decides whether to inline a variable at a call site

    callSiteInline is used at call sites, so it is a bit more generous.
    It's a very important function that embodies lots of heuristics.
    A non-WHNF can be inlined if it doesn't occur inside a lambda,
    and occurs exactly once or
        occurs once in each branch of a case and is small

    If the thing is in WHNF, there's no danger of duplicating work,
    so we can inline if it occurs once, or is small

    NOTE: we don't want to inline top-level functions that always diverge.
    It just makes the code bigger.  Tt turns out that the convenient way to prevent
    them inlining is to give them a NOINLINE pragma, which we do in
    StrictAnal.addStrictnessInfoToTopId
    -}

    callSiteInline :: Logger
                   -> DynFlags
                   -> Int                   -- Case depth
                   -> Id                    -- The Id
                   -> Bool                  -- True <=> unfolding is active
                   -> Bool                  -- True if there are no arguments at all (incl type args)
                   -> [ArgSummary]          -- One for each value arg; True if it is interesting
                   -> CallCtxt              -- True <=> continuation is interesting
                   -> Maybe CoreExpr        -- Unfolding, if any

    data ArgSummary = TrivArg       -- Nothing interesting
                    | NonTrivArg    -- Arg has structure
                    | ValueArg      -- Arg is a con-app or PAP
                                    -- ..or con-like. Note [Conlike is interesting]

    instance Outputable ArgSummary where
      ppr :: ArgSummary -> SDoc
    ppr ArgSummary
    TrivArg    = String -> SDoc
    text String
    "TrivArg"
      ppr ArgSummary
    NonTrivArg = String -> SDoc
    text String
    "NonTrivArg"
      ppr ArgSummary
    ValueArg   = String -> SDoc
    text String
    "ValueArg"

    nonTriv ::  ArgSummary -> Bool
    nonTriv :: ArgSummary -> Bool
    nonTriv ArgSummary
    TrivArg = Bool
    False
    nonTriv ArgSummary
    _       = Bool
    True

    data CallCtxt
      = BoringCtxt
      | RhsCtxt             -- Rhs of a let-binding; see Note [RHS of lets]
      | DiscArgCtxt         -- Argument of a function with non-zero arg discount
      | RuleArgCtxt         -- We are somewhere in the argument of a function with rules

      | ValAppCtxt          -- We're applied to at least one value arg
                            -- This arises when we have ((f x |> co) y)
                            -- Then the (f x) has argument 'x' but in a ValAppCtxt

      | CaseCtxt            -- We're the scrutinee of a case
                            -- that decomposes its scrutinee

    instance Outputable CallCtxt where
      ppr :: CallCtxt -> SDoc
    ppr CallCtxt
    CaseCtxt    = String -> SDoc
    text String
    "CaseCtxt"
      ppr CallCtxt
    ValAppCtxt  = String -> SDoc
    text String
    "ValAppCtxt"
      ppr CallCtxt
    BoringCtxt  = String -> SDoc
    text String
    "BoringCtxt"
      ppr CallCtxt
    RhsCtxt     = String -> SDoc
    text String
    "RhsCtxt"
      ppr CallCtxt
    DiscArgCtxt = String -> SDoc
    text String
    "DiscArgCtxt"
      ppr CallCtxt
    RuleArgCtxt = String -> SDoc
    text String
    "RuleArgCtxt"

    callSiteInline :: Logger
    -> DynFlags
    -> Int
    -> Id
    -> Bool
    -> Bool
    -> [ArgSummary]
    -> CallCtxt
    -> Maybe CoreExpr
    callSiteInline Logger
    logger DynFlags
    dflags !Int
    case_depth Id
    id Bool
    active_unfolding Bool
    lone_variable [ArgSummary]
    arg_infos CallCtxt
    cont_info
      = case Id -> Unfolding
    idUnfolding Id
    id of
          -- idUnfolding checks for loop-breakers, returning NoUnfolding
          -- Things with an INLINE pragma may have an unfolding *and*
          -- be a loop breaker  (maybe the knot is not yet untied)
            CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
    uf_tmpl = CoreExpr
    unf_template
                          , uf_is_work_free :: Unfolding -> Bool
    uf_is_work_free = Bool
    is_wf
                          , uf_guidance :: Unfolding -> UnfoldingGuidance
    uf_guidance = UnfoldingGuidance
    guidance, uf_expandable :: Unfolding -> Bool
    uf_expandable = Bool
    is_exp }
              | Bool
    active_unfolding -> Logger
    -> DynFlags
    -> Int
    -> Id
    -> Bool
    -> [ArgSummary]
    -> CallCtxt
    -> CoreExpr
    -> Bool
    -> Bool
    -> UnfoldingGuidance
    -> Maybe CoreExpr
    tryUnfolding Logger
    logger DynFlags
    dflags Int
    case_depth Id
    id Bool
    lone_variable
                                        [ArgSummary]
    arg_infos CallCtxt
    cont_info CoreExpr
    unf_template
                                        Bool
    is_wf Bool
    is_exp UnfoldingGuidance
    guidance
              | Bool
    otherwise -> Logger
    -> DynFlags
    -> Id
    -> String
    -> SDoc
    -> Maybe CoreExpr
    -> Maybe CoreExpr
    forall a. Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline Logger
    logger DynFlags
    dflags Id
    id String
    "Inactive unfolding:" (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    id) Maybe CoreExpr
    forall a. Maybe a
    Nothing
            Unfolding
    NoUnfolding      -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
            Unfolding
    BootUnfolding    -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
            OtherCon {}      -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
            DFunUnfolding {} -> Maybe CoreExpr
    forall a. Maybe a
    Nothing     -- Never unfold a DFun

    -- | Report the inlining of an identifier's RHS to the user, if requested.
    traceInline :: Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline :: forall a. Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline Logger
    logger DynFlags
    dflags Id
    inline_id String
    str SDoc
    doc a
    result
      -- We take care to ensure that doc is used in only one branch, ensuring that
      -- the simplifier can push its allocation into the branch. See Note [INLINE
      -- conditional tracing utilities].
      | Bool
    enable    = Logger -> TraceAction a
    forall a. Logger -> TraceAction a
    putTraceMsg Logger
    logger DynFlags
    dflags String
    str SDoc
    doc a
    result
      | Bool
    otherwise = a
    result
      where
        enable :: Bool
    enable
          | DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_inlinings DynFlags
    dflags Bool -> Bool -> Bool
    && DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_verbose_core2core DynFlags
    dflags
          = Bool
    True
          | Just String
    prefix <- DynFlags -> Maybe String
    inlineCheck DynFlags
    dflags
          = String
    prefix String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` OccName -> String
    occNameString (Id -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName Id
    inline_id)
          | Bool
    otherwise
          = Bool
    False
    {-# INLINE traceInline #-} -- see Note [INLINE conditional tracing utilities]

    {- Note [Avoid inlining into deeply nested cases]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Consider a function f like this:

      f arg1 arg2 =
        case ...
          ... -> g arg1
          ... -> g arg2

    This function is small. So should be safe to inline.
    However sometimes this doesn't quite work out like that.
    Consider this code:

    f1 arg1 arg2 ... = ...
        case _foo of
          alt1 -> ... f2 arg1 ...
          alt2 -> ... f2 arg2 ...

    f2 arg1 arg2 ... = ...
        case _foo of
          alt1 -> ... f3 arg1 ...
          alt2 -> ... f3 arg2 ...

    f3 arg1 arg2 ... = ...

    ... repeats up to n times. And then f1 is
    applied to some arguments:

    foo = ... f1 <interestingArgs> ...

    Initially f2..fn are not interesting to inline so we don't.
    However we see that f1 is applied to interesting args.
    So it's an obvious choice to inline those:

    foo =
        ...
          case _foo of
            alt1 -> ... f2 <interestingArg> ...
            alt2 -> ... f2 <interestingArg> ...

    As a result we go and inline f2 both mentions of f2 in turn are now applied to interesting
    arguments and f2 is small:

    foo =
        ...
          case _foo of
            alt1 -> ... case _foo of
                alt1 -> ... f3 <interestingArg> ...
                alt2 -> ... f3 <interestingArg> ...

            alt2 -> ... case _foo of
                alt1 -> ... f3 <interestingArg> ...
                alt2 -> ... f3 <interestingArg> ...

    The same thing happens for each binding up to f_n, duplicating the amount of inlining
    done in each step. Until at some point we are either done or run out of simplifier
    ticks/RAM. This pattern happened #18730.

    To combat this we introduce one more heuristic when weighing inlining decision.
    We keep track of a "case-depth". Which increases each time we look inside a case
    expression with more than one alternative.

    We then apply a penalty to inlinings based on the case-depth at which they would
    be inlined. Bounding the number of inlinings in such a scenario.

    The heuristic can be tuned in two ways:

    * We can ignore the first n levels of case nestings for inlining decisions using
      -funfolding-case-threshold.
    * The penalty grows linear with the depth. It's computed as size*(depth-threshold)/scaling.
      Scaling can be set with -funfolding-case-scaling.

    Some guidance on setting these defaults:

    * A low treshold (<= 2) is needed to prevent exponential cases from spiraling out of
      control. We picked 2 for no particular reason.
    * Scaling the penalty by any more than 30 means the reproducer from
      T18730 won't compile even with reasonably small values of n. Instead
      it will run out of runs/ticks. This means to positively affect the reproducer
      a scaling <= 30 is required.
    * A scaling of >= 15 still causes a few very large regressions on some nofib benchmarks.
      (+80% for gc/fulsom, +90% for real/ben-raytrace, +20% for spectral/fibheaps)
    * A scaling of >= 25 showed no regressions on nofib. However it showed a number of
      (small) regression for compiler perf benchmarks.

    The end result is that we are settling for a scaling of 30, with a threshold of 2.
    This gives us minimal compiler perf regressions. No nofib runtime regressions and
    will still avoid this pattern sometimes. This is a "safe" default, where we err on
    the side of compiler blowup instead of risking runtime regressions.

    For cases where the default falls short the flag can be changed to allow more/less inlining as
    needed on a per-module basis.

    -}

    tryUnfolding :: Logger -> DynFlags -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt
                 -> CoreExpr -> Bool -> Bool -> UnfoldingGuidance
                 -> Maybe CoreExpr
    tryUnfolding :: Logger
    -> DynFlags
    -> Int
    -> Id
    -> Bool
    -> [ArgSummary]
    -> CallCtxt
    -> CoreExpr
    -> Bool
    -> Bool
    -> UnfoldingGuidance
    -> Maybe CoreExpr
    tryUnfolding Logger
    logger DynFlags
    dflags !Int
    case_depth Id
    id Bool
    lone_variable
                 [ArgSummary]
    arg_infos CallCtxt
    cont_info CoreExpr
    unf_template
                 Bool
    is_wf Bool
    is_exp UnfoldingGuidance
    guidance
     = case UnfoldingGuidance
    guidance of
         UnfoldingGuidance
    UnfNever -> Logger
    -> DynFlags
    -> Id
    -> String
    -> SDoc
    -> Maybe CoreExpr
    -> Maybe CoreExpr
    forall a. Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline Logger
    logger DynFlags
    dflags Id
    id String
    str (String -> SDoc
    text String
    "UnfNever") Maybe CoreExpr
    forall a. Maybe a
    Nothing

         UnfWhen { ug_arity :: UnfoldingGuidance -> Int
    ug_arity = Int
    uf_arity, ug_unsat_ok :: UnfoldingGuidance -> Bool
    ug_unsat_ok = Bool
    unsat_ok, ug_boring_ok :: UnfoldingGuidance -> Bool
    ug_boring_ok = Bool
    boring_ok }
            | Bool
    enough_args Bool -> Bool -> Bool
    && (Bool
    boring_ok Bool -> Bool -> Bool
    || Bool
    some_benefit Bool -> Bool -> Bool
    || UnfoldingOpts -> Bool
    unfoldingVeryAggressive UnfoldingOpts
    uf_opts)
                    -- See Note [INLINE for small functions (3)]
            -> Logger
    -> DynFlags
    -> Id
    -> String
    -> SDoc
    -> Maybe CoreExpr
    -> Maybe CoreExpr
    forall a. Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline Logger
    logger DynFlags
    dflags Id
    id String
    str (Bool -> SDoc -> Bool -> SDoc
    mk_doc Bool
    some_benefit SDoc
    empty Bool
    True) (CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    unf_template)
            | Bool
    otherwise
            -> Logger
    -> DynFlags
    -> Id
    -> String
    -> SDoc
    -> Maybe CoreExpr
    -> Maybe CoreExpr
    forall a. Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline Logger
    logger DynFlags
    dflags Id
    id String
    str (Bool -> SDoc -> Bool -> SDoc
    mk_doc Bool
    some_benefit SDoc
    empty Bool
    False) Maybe CoreExpr
    forall a. Maybe a
    Nothing
            where
              some_benefit :: Bool
    some_benefit = Int -> Bool
    calc_some_benefit Int
    uf_arity
              enough_args :: Bool
    enough_args = (Int
    n_val_args Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    uf_arity) Bool -> Bool -> Bool
    || (Bool
    unsat_ok Bool -> Bool -> Bool
    && Int
    n_val_args Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0)

         UnfIfGoodArgs { ug_args :: UnfoldingGuidance -> [Int]
    ug_args = [Int]
    arg_discounts, ug_res :: UnfoldingGuidance -> Int
    ug_res = Int
    res_discount, ug_size :: UnfoldingGuidance -> Int
    ug_size = Int
    size }
            | UnfoldingOpts -> Bool
    unfoldingVeryAggressive UnfoldingOpts
    uf_opts
            -> Logger
    -> DynFlags
    -> Id
    -> String
    -> SDoc
    -> Maybe CoreExpr
    -> Maybe CoreExpr
    forall a. Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline Logger
    logger DynFlags
    dflags Id
    id String
    str (Bool -> SDoc -> Bool -> SDoc
    mk_doc Bool
    some_benefit SDoc
    extra_doc Bool
    True) (CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    unf_template)
            | Bool
    is_wf Bool -> Bool -> Bool
    && Bool
    some_benefit Bool -> Bool -> Bool
    && Bool
    small_enough
            -> Logger
    -> DynFlags
    -> Id
    -> String
    -> SDoc
    -> Maybe CoreExpr
    -> Maybe CoreExpr
    forall a. Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline Logger
    logger DynFlags
    dflags Id
    id String
    str (Bool -> SDoc -> Bool -> SDoc
    mk_doc Bool
    some_benefit SDoc
    extra_doc Bool
    True) (CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    unf_template)
            | Bool
    otherwise
            -> Logger
    -> DynFlags
    -> Id
    -> String
    -> SDoc
    -> Maybe CoreExpr
    -> Maybe CoreExpr
    forall a. Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
    traceInline Logger
    logger DynFlags
    dflags Id
    id String
    str (Bool -> SDoc -> Bool -> SDoc
    mk_doc Bool
    some_benefit SDoc
    extra_doc Bool
    False) Maybe CoreExpr
    forall a. Maybe a
    Nothing
            where
              some_benefit :: Bool
    some_benefit = Int -> Bool
    calc_some_benefit ([Int] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    arg_discounts)
              extra_doc :: SDoc
    extra_doc = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "case depth =" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    case_depth
                               , String -> SDoc
    text String
    "depth based penalty =" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    depth_penalty
                               , String -> SDoc
    text String
    "discounted size =" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    adjusted_size ]
              -- See Note [Avoid inlining into deeply nested cases]
              depth_treshold :: Int
    depth_treshold = UnfoldingOpts -> Int
    unfoldingCaseThreshold UnfoldingOpts
    uf_opts
              depth_scaling :: Int
    depth_scaling = UnfoldingOpts -> Int
    unfoldingCaseScaling UnfoldingOpts
    uf_opts
              depth_penalty :: Int
    depth_penalty | Int
    case_depth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    depth_treshold = Int
    0
                            | Bool
    otherwise       = (Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    case_depth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    depth_treshold)) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    depth_scaling
              adjusted_size :: Int
    adjusted_size = Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    depth_penalty Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    discount
              small_enough :: Bool
    small_enough = Int
    adjusted_size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= UnfoldingOpts -> Int
    unfoldingUseThreshold UnfoldingOpts
    uf_opts
              discount :: Int
    discount = [Int] -> Int -> [ArgSummary] -> CallCtxt -> Int
    computeDiscount [Int]
    arg_discounts Int
    res_discount [ArgSummary]
    arg_infos CallCtxt
    cont_info

      where
        uf_opts :: UnfoldingOpts
    uf_opts = DynFlags -> UnfoldingOpts
    unfoldingOpts DynFlags
    dflags
        mk_doc :: Bool -> SDoc -> Bool -> SDoc
    mk_doc Bool
    some_benefit SDoc
    extra_doc Bool
    yes_or_no
          = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "arg infos" SDoc -> SDoc -> SDoc
    <+> [ArgSummary] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ArgSummary]
    arg_infos
                 , String -> SDoc
    text String
    "interesting continuation" SDoc -> SDoc -> SDoc
    <+> CallCtxt -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CallCtxt
    cont_info
                 , String -> SDoc
    text String
    "some_benefit" SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    some_benefit
                 , String -> SDoc
    text String
    "is exp:" SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    is_exp
                 , String -> SDoc
    text String
    "is work-free:" SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    is_wf
                 , String -> SDoc
    text String
    "guidance" SDoc -> SDoc -> SDoc
    <+> UnfoldingGuidance -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UnfoldingGuidance
    guidance
                 , SDoc
    extra_doc
                 , String -> SDoc
    text String
    "ANSWER =" SDoc -> SDoc -> SDoc
    <+> if Bool
    yes_or_no then String -> SDoc
    text String
    "YES" else String -> SDoc
    text String
    "NO"]

        ctx :: SDocContext
    ctx = DynFlags -> PprStyle -> SDocContext
    initSDocContext DynFlags
    dflags PprStyle
    defaultDumpStyle
        str :: String
    str = String
    "Considering inlining: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SDocContext -> SDoc -> String
    showSDocDump SDocContext
    ctx (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    id)
        n_val_args :: Int
    n_val_args = [ArgSummary] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ArgSummary]
    arg_infos

               -- some_benefit is used when the RHS is small enough
               -- and the call has enough (or too many) value
               -- arguments (ie n_val_args >= arity). But there must
               -- be *something* interesting about some argument, or the
               -- result context, to make it worth inlining
        calc_some_benefit :: Arity -> Bool   -- The Arity is the number of args
                                             -- expected by the unfolding
        calc_some_benefit :: Int -> Bool
    calc_some_benefit Int
    uf_arity
           | Bool -> Bool
    not Bool
    saturated = Bool
    interesting_args       -- Under-saturated
                                            -- Note [Unsaturated applications]
           | Bool
    otherwise = Bool
    interesting_args   -- Saturated or over-saturated
                      Bool -> Bool -> Bool
    || Bool
    interesting_call
          where
            saturated :: Bool
    saturated      = Int
    n_val_args Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    uf_arity
            over_saturated :: Bool
    over_saturated = Int
    n_val_args Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    uf_arity
            interesting_args :: Bool
    interesting_args = (ArgSummary -> Bool) -> [ArgSummary] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ArgSummary -> Bool
    nonTriv [ArgSummary]
    arg_infos
                    -- NB: (any nonTriv arg_infos) looks at the
                    -- over-saturated args too which is "wrong";
                    -- but if over-saturated we inline anyway.

            interesting_call :: Bool
    interesting_call
              | Bool
    over_saturated
              = Bool
    True
              | Bool
    otherwise
              = case CallCtxt
    cont_info of
                  CallCtxt
    CaseCtxt   -> Bool -> Bool
    not (Bool
    lone_variable Bool -> Bool -> Bool
    && Bool
    is_exp)  -- Note [Lone variables]
                  CallCtxt
    ValAppCtxt -> Bool
    True                           -- Note [Cast then apply]
                  CallCtxt
    RuleArgCtxt -> Int
    uf_arity Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0  -- See Note [Unfold info lazy contexts]
                  CallCtxt
    DiscArgCtxt -> Int
    uf_arity Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0  -- Note [Inlining in ArgCtxt]
                  CallCtxt
    RhsCtxt     -> Int
    uf_arity Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0  --
                  CallCtxt
    _other      -> Bool
    False         -- See Note [Nested functions]

    {-
    Note [Unfold into lazy contexts], Note [RHS of lets]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When the call is the argument of a function with a RULE, or the RHS of a let,
    we are a little bit keener to inline.  For example
         f y = (y,y,y)
         g y = let x = f y in ...(case x of (a,b,c) -> ...) ...
    We'd inline 'f' if the call was in a case context, and it kind-of-is,
    only we can't see it.  Also
         x = f v
    could be expensive whereas
         x = case v of (a,b) -> a
    is patently cheap and may allow more eta expansion.
    So we treat the RHS of a let as not-totally-boring.

    Note [Unsaturated applications]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When a call is not saturated, we *still* inline if one of the
    arguments has interesting structure.  That's sometimes very important.
    A good example is the Ord instance for Bool in Base:

     Rec {
        $fOrdBool =GHC.Classes.D:Ord
                     @ Bool
                     ...
                     $cmin_ajX

        $cmin_ajX [Occ=LoopBreaker] :: Bool -> Bool -> Bool
        $cmin_ajX = GHC.Classes.$dmmin @ Bool $fOrdBool
      }

    But the defn of GHC.Classes.$dmmin is:

      $dmmin :: forall a. GHC.Classes.Ord a => a -> a -> a
        {- Arity: 3, HasNoCafRefs, Strictness: SLL,
           Unfolding: (\ @ a $dOrd :: GHC.Classes.Ord a x :: a y :: a ->
                       case @ a GHC.Classes.<= @ a $dOrd x y of wild {
                         GHC.Types.False -> y GHC.Types.True -> x }) -}

    We *really* want to inline $dmmin, even though it has arity 3, in
    order to unravel the recursion.

    Note [Things to watch]
    ~~~~~~~~~~~~~~~~~~~~~~
    *   { y = I# 3; x = y `cast` co; ...case (x `cast` co) of ... }
        Assume x is exported, so not inlined unconditionally.
        Then we want x to inline unconditionally; no reason for it
        not to, and doing so avoids an indirection.

    *   { x = I# 3; ....f x.... }
        Make sure that x does not inline unconditionally!
        Lest we get extra allocation.

    Note [Inlining an InlineRule]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    An InlineRules is used for
      (a) programmer INLINE pragmas
      (b) inlinings from worker/wrapper

    For (a) the RHS may be large, and our contract is that we *only* inline
    when the function is applied to all the arguments on the LHS of the
    source-code defn.  (The uf_arity in the rule.)

    However for worker/wrapper it may be worth inlining even if the
    arity is not satisfied (as we do in the CoreUnfolding case) so we don't
    require saturation.

    Note [Nested functions]
    ~~~~~~~~~~~~~~~~~~~~~~~
    At one time we treated a call of a non-top-level function as
    "interesting" (regardless of how boring the context) in the hope
    that inlining it would eliminate the binding, and its allocation.
    Specifically, in the default case of interesting_call we had
       _other -> not is_top && uf_arity > 0

    But actually postInlineUnconditionally does some of this and overall
    it makes virtually no difference to nofib.  So I simplified away this
    special case

    Note [Cast then apply]
    ~~~~~~~~~~~~~~~~~~~~~~
    Consider
       myIndex = __inline_me ( (/\a. <blah>) |> co )
       co :: (forall a. a -> a) ~ (forall a. T a)
         ... /\a.\x. case ((myIndex a) |> sym co) x of { ... } ...

    We need to inline myIndex to unravel this; but the actual call (myIndex a) has
    no value arguments.  The ValAppCtxt gives it enough incentive to inline.

    Note [Inlining in ArgCtxt]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    The condition (arity > 0) here is very important, because otherwise
    we end up inlining top-level stuff into useless places; eg
       x = I# 3#
       f = \y.  g x
    This can make a very big difference: it adds 16% to nofib 'integer' allocs,
    and 20% to 'power'.

    At one stage I replaced this condition by 'True' (leading to the above
    slow-down).  The motivation was test eyeball/inline1.hs; but that seems
    to work ok now.

    NOTE: arguably, we should inline in ArgCtxt only if the result of the
    call is at least CONLIKE.  At least for the cases where we use ArgCtxt
    for the RHS of a 'let', we only profit from the inlining if we get a
    CONLIKE thing (modulo lets).

    Note [Lone variables]   See also Note [Interaction of exprIsWorkFree and lone variables]
    ~~~~~~~~~~~~~~~~~~~~~   which appears below
    The "lone-variable" case is important.  I spent ages messing about
    with unsatisfactory variants, but this is nice.  The idea is that if a
    variable appears all alone

            as an arg of lazy fn, or rhs    BoringCtxt
            as scrutinee of a case          CaseCtxt
            as arg of a fn                  ArgCtxt
    AND
            it is bound to a cheap expression

    then we should not inline it (unless there is some other reason,
    e.g. it is the sole occurrence).  That is what is happening at
    the use of 'lone_variable' in 'interesting_call'.

    Why?  At least in the case-scrutinee situation, turning
            let x = (a,b) in case x of y -> ...
    into
            let x = (a,b) in case (a,b) of y -> ...
    and thence to
            let x = (a,b) in let y = (a,b) in ...
    is bad if the binding for x will remain.

    Another example: I discovered that strings
    were getting inlined straight back into applications of 'error'
    because the latter is strict.
            s = "foo"
            f = \x -> ...(error s)...

    Fundamentally such contexts should not encourage inlining because, provided
    the RHS is "expandable" (see Note [exprIsExpandable] in GHC.Core.Utils) the
    context can ``see'' the unfolding of the variable (e.g. case or a
    RULE) so there's no gain.

    However, watch out:

     * Consider this:
            foo = _inline_ (\n. [n])
            bar = _inline_ (foo 20)
            baz = \n. case bar of { (m:_) -> m + n }
       Here we really want to inline 'bar' so that we can inline 'foo'
       and the whole thing unravels as it should obviously do.  This is
       important: in the NDP project, 'bar' generates a closure data
       structure rather than a list.

       So the non-inlining of lone_variables should only apply if the
       unfolding is regarded as cheap; because that is when exprIsConApp_maybe
       looks through the unfolding.  Hence the "&& is_wf" in the
       InlineRule branch.

     * Even a type application or coercion isn't a lone variable.
       Consider
            case $fMonadST @ RealWorld of { :DMonad a b c -> c }
       We had better inline that sucker!  The case won't see through it.

       For now, I'm treating treating a variable applied to types
       in a *lazy* context "lone". The motivating example was
            f = /\a. \x. BIG
            g = /\a. \y.  h (f a)
       There's no advantage in inlining f here, and perhaps
       a significant disadvantage.  Hence some_val_args in the Stop case

    Note [Interaction of exprIsWorkFree and lone variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The lone-variable test says "don't inline if a case expression
    scrutinises a lone variable whose unfolding is cheap".  It's very
    important that, under these circumstances, exprIsConApp_maybe
    can spot a constructor application. So, for example, we don't
    consider
            let x = e in (x,x)
    to be cheap, and that's good because exprIsConApp_maybe doesn't
    think that expression is a constructor application.

    In the 'not (lone_variable && is_wf)' test, I used to test is_value
    rather than is_wf, which was utterly wrong, because the above
    expression responds True to exprIsHNF, which is what sets is_value.

    This kind of thing can occur if you have

            {-# INLINE foo #-}
            foo = let x = e in (x,x)

    which Roman did.

    -}

    computeDiscount :: [Int] -> Int -> [ArgSummary] -> CallCtxt
                    -> Int
    computeDiscount :: [Int] -> Int -> [ArgSummary] -> CallCtxt -> Int
    computeDiscount [Int]
    arg_discounts Int
    res_discount [ArgSummary]
    arg_infos CallCtxt
    cont_info

      = Int
    10          -- Discount of 10 because the result replaces the call
                    -- so we count 10 for the function itself

        Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [Int] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    actual_arg_discounts
                   -- Discount of 10 for each arg supplied,
                   -- because the result replaces the call

        Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    total_arg_discount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    res_discount'
      where
        actual_arg_discounts :: [Int]
    actual_arg_discounts = (Int -> ArgSummary -> Int) -> [Int] -> [ArgSummary] -> [Int]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> ArgSummary -> Int
    forall {a}. Num a => a -> ArgSummary -> a
    mk_arg_discount [Int]
    arg_discounts [ArgSummary]
    arg_infos
        total_arg_discount :: Int
    total_arg_discount   = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int]
    actual_arg_discounts

        mk_arg_discount :: a -> ArgSummary -> a
    mk_arg_discount a
    _        ArgSummary
    TrivArg    = a
    0
        mk_arg_discount a
    _        ArgSummary
    NonTrivArg = a
    10
        mk_arg_discount a
    discount ArgSummary
    ValueArg   = a
    discount

        res_discount' :: Int
    res_discount'
          | Ordering
    LT <- [Int]
    arg_discounts [Int] -> [ArgSummary] -> Ordering
    forall a b. [a] -> [b] -> Ordering
    `compareLength` [ArgSummary]
    arg_infos
          = Int
    res_discount   -- Over-saturated
          | Bool
    otherwise
          = case CallCtxt
    cont_info of
               CallCtxt
    BoringCtxt  -> Int
    0
               CallCtxt
    CaseCtxt    -> Int
    res_discount  -- Presumably a constructor
               CallCtxt
    ValAppCtxt  -> Int
    res_discount  -- Presumably a function
               CallCtxt
    _           -> Int
    40 Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `min` Int
    res_discount
                    -- ToDo: this 40 `min` res_discount doesn't seem right
                    --   for DiscArgCtxt it shouldn't matter because the function will
                    --       get the arg discount for any non-triv arg
                    --   for RuleArgCtxt we do want to be keener to inline; but not only
                    --       constructor results
                    --   for RhsCtxt I suppose that exposing a data con is good in general
                    --   And 40 seems very arbitrary
                    --
                    -- res_discount can be very large when a function returns
                    -- constructors; but we only want to invoke that large discount
                    -- when there's a case continuation.
                    -- Otherwise we, rather arbitrarily, threshold it.  Yuk.
                    -- But we want to avoid inlining large functions that return
                    -- constructors into contexts that are simply "interesting"