    {-
    (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.
    -}

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

            ExprSize(..), sizeExpr,

            ArgSummary(..), nonTriv,
            CallCtxt(..),

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

            inlineBoringOk, calcUnfoldingGuidance,
            uncondInlineJoin
        ) where

    import GHC.Prelude

    import GHC.Core
    import GHC.Core.Utils
    import GHC.Core.DataCon
    import GHC.Core.Type

    import GHC.Types.Id
    import GHC.Types.Literal
    import GHC.Types.Id.Info
    import GHC.Types.RepType ( isZeroBitTy )
    import GHC.Types.Basic  ( Arity, RecFlag )
    import GHC.Types.ForeignCall
    import GHC.Types.Tickish

    import GHC.Builtin.PrimOps
    import GHC.Builtin.Names
    import GHC.Data.Bag
    import GHC.Utils.Misc
    import GHC.Utils.Outputable

    import qualified Data.ByteString as BS

    -- | 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

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

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

       , UnfoldingOpts -> Maybe String
    unfoldingReportPrefix :: !(Maybe String)
          -- ^ Only report inlining decisions for names with this prefix
       }

    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

          -- Don't filter inlining decision reports
       , unfoldingReportPrefix :: Maybe String
    unfoldingReportPrefix = Maybe String
    forall a. Maybe a
    Nothing
       }

    -- Helpers for "GHC.Driver.Session"

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

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

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

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

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

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

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

    updateReportPrefix :: Maybe String -> UnfoldingOpts -> UnfoldingOpts
    updateReportPrefix :: Maybe String -> UnfoldingOpts -> UnfoldingOpts
    updateReportPrefix Maybe String
    n UnfoldingOpts
    opts = UnfoldingOpts
    opts { unfoldingReportPrefix = n }

    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
    forall doc. IsLine doc => String -> doc
    text String
    "TrivArg"
      ppr ArgSummary
    NonTrivArg = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "NonTrivArg"
      ppr ArgSummary
    ValueArg   = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ValueArg"

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

    data CallCtxt
      = BoringCtxt
      | RhsCtxt RecFlag     -- 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
    forall doc. IsLine doc => String -> doc
    text String
    "CaseCtxt"
      ppr CallCtxt
    ValAppCtxt  = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ValAppCtxt"
      ppr CallCtxt
    BoringCtxt  = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "BoringCtxt"
      ppr (RhsCtxt RecFlag
    ir)= String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "RhsCtxt" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (RecFlag -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RecFlag
    ir)
      ppr CallCtxt
    DiscArgCtxt = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "DiscArgCtxt"
      ppr CallCtxt
    RuleArgCtxt = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "RuleArgCtxt"

    {-
    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
    e Id
    b Type
    _ [Alt Id]
    alts)
          | [Alt Id] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Id]
    alts
          = Int -> CoreExpr -> Bool
    go Int
    credit CoreExpr
    e   -- EmptyCase is like e
          | Just CoreExpr
    rhs <- CoreExpr -> Id -> [Alt Id] -> Maybe CoreExpr
    isUnsafeEqualityCase CoreExpr
    e Id
    b [Alt Id]
    alts
          = Int -> CoreExpr -> Bool
    go Int
    credit CoreExpr
    rhs -- See Note [Inline unsafeCoerce]
        go Int
    _      (Var {})                     = Bool
    boringCxtOk
        go Int
    _      (Lit Literal
    l)                      = Literal -> Bool
    litIsTrivial Literal
    l Bool -> Bool -> Bool
    && Bool
    boringCxtOk
        go Int
    _      CoreExpr
    _                            = Bool
    boringCxtNotOk

    calcUnfoldingGuidance
            :: UnfoldingOpts
            -> Bool          -- Definitely a top-level, bottoming binding
            -> Bool          -- True <=> join point
            -> CoreExpr      -- Expression to look at
            -> UnfoldingGuidance
    calcUnfoldingGuidance :: UnfoldingOpts -> Bool -> Bool -> CoreExpr -> UnfoldingGuidance
    calcUnfoldingGuidance UnfoldingOpts
    opts Bool
    is_top_bottoming Bool
    is_join (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 -> Bool -> CoreExpr -> UnfoldingGuidance
    calcUnfoldingGuidance UnfoldingOpts
    opts Bool
    is_top_bottoming Bool
    is_join CoreExpr
    expr
    calcUnfoldingGuidance UnfoldingOpts
    opts Bool
    is_top_bottoming Bool
    is_join 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
            | Bool -> CoreExpr -> [Id] -> Int -> CoreExpr -> Int -> Bool
    uncondInline Bool
    is_join CoreExpr
    expr [Id]
    bndrs Int
    n_val_bndrs CoreExpr
    body 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 a. [a] -> 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 b a. (b -> a -> b) -> b -> Bag a -> b
    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 in CoreToStg -- 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. And it really is, because we regard
      case unsafeEqualityProof @a @b of UnsafeRefl -> rhs
    as trivial iff rhs is. 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 :: Bool -> CoreExpr -> [Var] -> Arity -> CoreExpr -> 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 :: Bool -> CoreExpr -> [Id] -> Int -> CoreExpr -> Int -> Bool
    uncondInline Bool
    is_join CoreExpr
    rhs [Id]
    bndrs Int
    arity CoreExpr
    body Int
    size
      | Bool
    is_join   = [Id] -> CoreExpr -> Bool
    uncondInlineJoin [Id]
    bndrs CoreExpr
    body
      | 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)

    uncondInlineJoin :: [Var] -> CoreExpr -> Bool
    -- See Note [Duplicating join points] point (DJ3) in GHC.Core.Opt.Simplify.Iteration
    uncondInlineJoin :: [Id] -> CoreExpr -> Bool
    uncondInlineJoin [Id]
    _bndrs CoreExpr
    body
      | CoreExpr -> Bool
    exprIsTrivial CoreExpr
    body
      = Bool
    True   -- Nullary constructors, literals

      | (Var Id
    v, [CoreExpr]
    args) <- CoreExpr -> (CoreExpr, [CoreExpr])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs CoreExpr
    body
      , (CoreExpr -> Bool) -> [CoreExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all CoreExpr -> Bool
    exprIsTrivial [CoreExpr]
    args
      , Id -> Bool
    isJoinId Id
    v   -- Indirection to another join point; always inline
      = Bool
    True

      | Bool
    otherwise
      = Bool
    False

    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
    isZeroBitId 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
    isZeroBitExpr 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
    isZeroBitId 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 a b. (a -> b -> b) -> b -> [a] -> b
    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 a. Num a => [a] -> a
    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 a. [a] -> 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 a. (a -> a -> a) -> [a] -> a
    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 a. (a -> a -> a) -> [a] -> a
    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 a. Eq a => a -> [a] -> 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 a b. (a -> b -> b) -> b -> [a] -> b
    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)
                  -- isUnliftedType is OK here: scrutinees have a fixed RuntimeRep (search for FRRCase)
              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 ConcreteTyVars
    _ -> 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)
          | JoinPoint Int
    join_arity <- Id -> JoinPointHood
    idJoinPointHood 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
    isZeroBitExpr 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    val_args)
               PrimOpId PrimOp
    op ConcreteTyVars
    _    -> PrimOp -> Int -> ExprSize
    primOpSize PrimOp
    op ([CoreExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    val_args)
               ClassOpId {}     -> 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 a. [a] -> 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
    || Bool -> Bool
    not (Type -> Bool
    isBoxedType (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

        -- don't count expressions such as State# RealWorld
        -- exclude join points, because they can be rep-polymorphic
        -- and typePrimRep will crash
        isZeroBitId :: Id -> Bool
    isZeroBitId Id
    id = Bool -> Bool
    not (Id -> Bool
    isJoinId Id
    id) Bool -> Bool -> Bool
    && HasDebugCallStack => Type -> Bool
    Type -> Bool
    isZeroBitTy (Id -> Type
    idType Id
    id)

        isZeroBitExpr :: Expr b -> Bool
    isZeroBitExpr (Var Id
    id)   = Id -> Bool
    isZeroBitId Id
    id
        isZeroBitExpr (Tick CoreTickish
    _ Expr b
    e) = Expr b -> Bool
    isZeroBitExpr Expr b
    e
        isZeroBitExpr 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
    LitNumBigNat 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 a. [a] -> 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 a. Eq a => a -> [a] -> 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
    0   -- Jumps are small, and we don't want penalise them

      -- Old version:
      -- 2 * (1 + n_val_args - 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 a. Eq a => a -> [a] -> 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 exponential 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
    forall doc. IsLine doc => String -> doc
    text String
    "TooBig"
      ppr (SizeIs Int
    a Bag (Id, Int)
    _ Int
    c) = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    brackets (Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    a SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    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