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

    -- | Unfolding creation
    module GHC.Core.Unfold.Make
       ( noUnfolding
       , mkUnfolding
       , mkCoreUnfolding
       , mkFinalUnfolding
       , mkFinalUnfolding'
       , mkSimpleUnfolding
       , mkWorkerUnfolding
       , mkInlineUnfoldingWithArity, mkInlineUnfoldingNoArity
       , mkInlinableUnfolding
       , mkWrapperUnfolding
       , mkCompulsoryUnfolding, mkCompulsoryUnfolding'
       , mkDFunUnfolding
       , mkDataConUnfolding
       , specUnfolding
       , certainlyWillInline
       )
    where

    import GHC.Prelude
    import GHC.Core
    import GHC.Core.Unfold
    import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
    import GHC.Core.Opt.Arity   ( manifestArity )
    import GHC.Core.DataCon
    import GHC.Core.Utils
    import GHC.Types.Basic
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Types.Demand ( DmdSig, isDeadEndSig )

    import GHC.Utils.Outputable
    import GHC.Utils.Misc
    import GHC.Utils.Panic

    import Data.Maybe ( fromMaybe )

    -- the very simple optimiser is used to optimise unfoldings
    import {-# SOURCE #-} GHC.Core.SimpleOpt

    mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Unfolding
    -- "Final" in the sense that this is a GlobalId that will not be further
    -- simplified; so the unfolding should be occurrence-analysed
    mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreArg -> Unfolding
    mkFinalUnfolding UnfoldingOpts
    opts UnfoldingSource
    src DmdSig
    strict_sig CoreArg
    expr = UnfoldingOpts
    -> UnfoldingSource
    -> DmdSig
    -> CoreArg
    -> Maybe UnfoldingCache
    -> Unfolding
    mkFinalUnfolding' UnfoldingOpts
    opts UnfoldingSource
    src DmdSig
    strict_sig CoreArg
    expr Maybe UnfoldingCache
    forall a. Maybe a
    Nothing

    -- See Note [Tying the 'CoreUnfolding' knot] for why interfaces need
    -- to pass a precomputed 'UnfoldingCache'
    mkFinalUnfolding' :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Maybe UnfoldingCache -> Unfolding
    -- "Final" in the sense that this is a GlobalId that will not be further
    -- simplified; so the unfolding should be occurrence-analysed
    mkFinalUnfolding' :: UnfoldingOpts
    -> UnfoldingSource
    -> DmdSig
    -> CoreArg
    -> Maybe UnfoldingCache
    -> Unfolding
    mkFinalUnfolding' UnfoldingOpts
    opts UnfoldingSource
    src DmdSig
    strict_sig CoreArg
    expr
      = UnfoldingOpts
    -> UnfoldingSource
    -> Bool
    -> Bool
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> Unfolding
    mkUnfolding UnfoldingOpts
    opts UnfoldingSource
    src
                    Bool
    True {- Top level -}
                    (DmdSig -> Bool
    isDeadEndSig DmdSig
    strict_sig)
                    Bool
    False {- Not a join point -}
                    CoreArg
    expr

    -- | Same as 'mkCompulsoryUnfolding' but simplifies the unfolding first
    mkCompulsoryUnfolding' :: SimpleOpts -> CoreExpr -> Unfolding
    mkCompulsoryUnfolding' :: SimpleOpts -> CoreArg -> Unfolding
    mkCompulsoryUnfolding' SimpleOpts
    opts CoreArg
    expr = CoreArg -> Unfolding
    mkCompulsoryUnfolding (HasDebugCallStack => SimpleOpts -> CoreArg -> CoreArg
    SimpleOpts -> CoreArg -> CoreArg
    simpleOptExpr SimpleOpts
    opts CoreArg
    expr)

    -- | Used for things that absolutely must be unfolded
    mkCompulsoryUnfolding :: CoreExpr -> Unfolding
    mkCompulsoryUnfolding :: CoreArg -> Unfolding
    mkCompulsoryUnfolding CoreArg
    expr
      = UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    CompulsorySrc Bool
    True
                        CoreArg
    expr Maybe UnfoldingCache
    forall a. Maybe a
    Nothing
                        (UnfWhen { ug_arity :: ArityInfo
    ug_arity = ArityInfo
    0    -- Arity of unfolding doesn't matter
                                 , ug_unsat_ok :: Bool
    ug_unsat_ok = Bool
    unSaturatedOk, ug_boring_ok :: Bool
    ug_boring_ok = Bool
    boringCxtOk })

    -- Note [Top-level flag on inline rules]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- Slight hack: note that mk_inline_rules conservatively sets the
    -- top-level flag to True.  It gets set more accurately by the simplifier
    -- Simplify.simplUnfolding.

    mkSimpleUnfolding :: UnfoldingOpts -> CoreExpr -> Unfolding
    mkSimpleUnfolding :: UnfoldingOpts -> CoreArg -> Unfolding
    mkSimpleUnfolding !UnfoldingOpts
    opts CoreArg
    rhs
      = UnfoldingOpts
    -> UnfoldingSource
    -> Bool
    -> Bool
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> Unfolding
    mkUnfolding UnfoldingOpts
    opts UnfoldingSource
    VanillaSrc Bool
    False Bool
    False Bool
    False CoreArg
    rhs Maybe UnfoldingCache
    forall a. Maybe a
    Nothing

    mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding
    mkDFunUnfolding :: [Var] -> DataCon -> [CoreArg] -> Unfolding
    mkDFunUnfolding [Var]
    bndrs DataCon
    con [CoreArg]
    ops
      | DataCon -> Bool
    isUnaryClassDataCon DataCon
    con
      = -- See (UCM5) in Note [Unary class magic] in GHC.Core.TyCon
        CoreArg -> Unfolding
    mkDataConUnfolding (CoreArg -> Unfolding) -> CoreArg -> Unfolding
    forall a b. (a -> b) -> a -> b
    $
        [Var] -> CoreArg -> CoreArg
    forall b. [b] -> Expr b -> Expr b
    mkLams [Var]
    bndrs  (CoreArg -> CoreArg) -> CoreArg -> CoreArg
    forall a b. (a -> b) -> a -> b
    $
        CoreArg -> [CoreArg] -> CoreArg
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (Var -> CoreArg
    forall b. Var -> Expr b
    Var (DataCon -> Var
    dataConWrapId DataCon
    con)) [CoreArg]
    ops
                    -- This application will satisfy the Core invariants
                    -- from Note [Representation polymorphism invariants] in GHC.Core,
                    -- because typeclass method types are never unlifted.

      | Bool
    otherwise
      = DFunUnfolding { df_bndrs :: [Var]
    df_bndrs = [Var]
    bndrs
                      , df_con :: DataCon
    df_con = DataCon
    con
                      , df_args :: [CoreArg]
    df_args = (CoreArg -> CoreArg) -> [CoreArg] -> [CoreArg]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreArg -> CoreArg
    occurAnalyseExpr [CoreArg]
    ops }
                      -- See Note [OccInfo in unfoldings and rules] in GHC.Core

    mkDataConUnfolding :: CoreExpr -> Unfolding
    -- Used for non-newtype data constructors with non-trivial wrappers
    mkDataConUnfolding :: CoreArg -> Unfolding
    mkDataConUnfolding CoreArg
    expr
      = UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    StableSystemSrc Bool
    True CoreArg
    expr Maybe UnfoldingCache
    forall a. Maybe a
    Nothing UnfoldingGuidance
    guide
        -- No need to simplify the expression
      where
        guide :: UnfoldingGuidance
    guide = UnfWhen { ug_arity :: ArityInfo
    ug_arity     = CoreArg -> ArityInfo
    manifestArity CoreArg
    expr
                        , ug_unsat_ok :: Bool
    ug_unsat_ok  = Bool
    unSaturatedOk
                        , ug_boring_ok :: Bool
    ug_boring_ok = CoreArg -> Bool
    inlineBoringOk CoreArg
    expr }
                -- inineBoringOk; sometimes wrappers are very simple, like
                --    \@a p q. K @a <coercion> p q
                -- and then we definitely want to inline it #25713

    mkWrapperUnfolding :: SimpleOpts -> CoreExpr -> Arity -> Unfolding
    -- Make the unfolding for the wrapper in a worker/wrapper split
    -- after demand/CPR analysis
    mkWrapperUnfolding :: SimpleOpts -> CoreArg -> ArityInfo -> Unfolding
    mkWrapperUnfolding SimpleOpts
    opts CoreArg
    expr ArityInfo
    arity
      = UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    StableSystemSrc Bool
    True
                        (HasDebugCallStack => SimpleOpts -> CoreArg -> CoreArg
    SimpleOpts -> CoreArg -> CoreArg
    simpleOptExpr SimpleOpts
    opts CoreArg
    expr) Maybe UnfoldingCache
    forall a. Maybe a
    Nothing
                        (UnfWhen { ug_arity :: ArityInfo
    ug_arity     = ArityInfo
    arity
                                 , ug_unsat_ok :: Bool
    ug_unsat_ok  = Bool
    unSaturatedOk
                                 , ug_boring_ok :: Bool
    ug_boring_ok = Bool
    boringCxtNotOk })

    mkWorkerUnfolding :: SimpleOpts -> (CoreExpr -> CoreExpr) -> Unfolding -> Unfolding
    -- See Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap
    mkWorkerUnfolding :: SimpleOpts -> (CoreArg -> CoreArg) -> Unfolding -> Unfolding
    mkWorkerUnfolding SimpleOpts
    opts CoreArg -> CoreArg
    work_fn
                      (CoreUnfolding { uf_src :: Unfolding -> UnfoldingSource
    uf_src = UnfoldingSource
    src, uf_tmpl :: Unfolding -> CoreArg
    uf_tmpl = CoreArg
    tmpl
                                     , uf_is_top :: Unfolding -> Bool
    uf_is_top = Bool
    top_lvl })
      | UnfoldingSource -> Bool
    isStableSource UnfoldingSource
    src
      = UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    src Bool
    top_lvl CoreArg
    new_tmpl Maybe UnfoldingCache
    forall a. Maybe a
    Nothing UnfoldingGuidance
    guidance
      where
        new_tmpl :: CoreArg
    new_tmpl = HasDebugCallStack => SimpleOpts -> CoreArg -> CoreArg
    SimpleOpts -> CoreArg -> CoreArg
    simpleOptExpr SimpleOpts
    opts (CoreArg -> CoreArg
    work_fn CoreArg
    tmpl)
        guidance :: UnfoldingGuidance
    guidance = UnfoldingOpts -> Bool -> Bool -> CoreArg -> UnfoldingGuidance
    calcUnfoldingGuidance (SimpleOpts -> UnfoldingOpts
    so_uf_opts SimpleOpts
    opts) Bool
    False Bool
    False CoreArg
    new_tmpl

    mkWorkerUnfolding SimpleOpts
    _ CoreArg -> CoreArg
    _ Unfolding
    _ = Unfolding
    noUnfolding

    -- | Make an INLINE unfolding that may be used unsaturated
    -- (ug_unsat_ok = unSaturatedOk) and that is reported as having its
    -- manifest arity (the number of outer lambdas applications will
    -- resolve before doing any work).
    mkInlineUnfoldingNoArity :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
    mkInlineUnfoldingNoArity :: SimpleOpts -> UnfoldingSource -> CoreArg -> Unfolding
    mkInlineUnfoldingNoArity SimpleOpts
    opts UnfoldingSource
    src CoreArg
    expr
      = UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    src
                        Bool
    True         -- Note [Top-level flag on inline rules]
                        CoreArg
    expr' Maybe UnfoldingCache
    forall a. Maybe a
    Nothing UnfoldingGuidance
    guide
      where
        expr' :: CoreArg
    expr' = HasDebugCallStack => SimpleOpts -> CoreArg -> CoreArg
    SimpleOpts -> CoreArg -> CoreArg
    simpleOptExpr SimpleOpts
    opts CoreArg
    expr
        guide :: UnfoldingGuidance
    guide = UnfWhen { ug_arity :: ArityInfo
    ug_arity = CoreArg -> ArityInfo
    manifestArity CoreArg
    expr'
                        , ug_unsat_ok :: Bool
    ug_unsat_ok = Bool
    unSaturatedOk
                        , ug_boring_ok :: Bool
    ug_boring_ok = Bool
    boring_ok }
        boring_ok :: Bool
    boring_ok = CoreArg -> Bool
    inlineBoringOk CoreArg
    expr'

    -- | Make an INLINE unfolding that will be used once the RHS has been saturated
    -- to the given arity.
    mkInlineUnfoldingWithArity :: SimpleOpts -> UnfoldingSource -> Arity -> CoreExpr -> Unfolding
    mkInlineUnfoldingWithArity :: SimpleOpts -> UnfoldingSource -> ArityInfo -> CoreArg -> Unfolding
    mkInlineUnfoldingWithArity SimpleOpts
    opts UnfoldingSource
    src ArityInfo
    arity CoreArg
    expr
      = UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    src
                        Bool
    True         -- Note [Top-level flag on inline rules]
                        CoreArg
    expr' Maybe UnfoldingCache
    forall a. Maybe a
    Nothing UnfoldingGuidance
    guide
      where
        expr' :: CoreArg
    expr' = HasDebugCallStack => SimpleOpts -> CoreArg -> CoreArg
    SimpleOpts -> CoreArg -> CoreArg
    simpleOptExpr SimpleOpts
    opts CoreArg
    expr
        guide :: UnfoldingGuidance
    guide = UnfWhen { ug_arity :: ArityInfo
    ug_arity = ArityInfo
    arity
                        , ug_unsat_ok :: Bool
    ug_unsat_ok = Bool
    needSaturated
                        , ug_boring_ok :: Bool
    ug_boring_ok = Bool
    boring_ok }
        -- See Note [INLINE pragmas and boring contexts] as to why we need to look
        -- at the arity here.
        boring_ok :: Bool
    boring_ok | ArityInfo
    arity ArityInfo -> ArityInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == ArityInfo
    0 = Bool
    True
                  | Bool
    otherwise  = CoreArg -> Bool
    inlineBoringOk CoreArg
    expr'

    mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
    mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> CoreArg -> Unfolding
    mkInlinableUnfolding SimpleOpts
    opts UnfoldingSource
    src CoreArg
    expr
      = UnfoldingOpts
    -> UnfoldingSource
    -> Bool
    -> Bool
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> Unfolding
    mkUnfolding (SimpleOpts -> UnfoldingOpts
    so_uf_opts SimpleOpts
    opts) UnfoldingSource
    src Bool
    False Bool
    False Bool
    False CoreArg
    expr' Maybe UnfoldingCache
    forall a. Maybe a
    Nothing
      where
        expr' :: CoreArg
    expr' = HasDebugCallStack => SimpleOpts -> CoreArg -> CoreArg
    SimpleOpts -> CoreArg -> CoreArg
    simpleOptExpr SimpleOpts
    opts CoreArg
    expr

    specUnfolding :: SimpleOpts
                  -> [Var] -> (CoreExpr -> CoreExpr)
                  -> [CoreArg]   -- LHS arguments in the RULE
                  -> Unfolding -> Unfolding
    -- See Note [Specialising unfoldings]
    -- specUnfolding spec_bndrs spec_args unf
    --   = \spec_bndrs. unf spec_args
    --
    specUnfolding :: SimpleOpts
    -> [Var]
    -> (CoreArg -> CoreArg)
    -> [CoreArg]
    -> Unfolding
    -> Unfolding
    specUnfolding SimpleOpts
    opts [Var]
    spec_bndrs CoreArg -> CoreArg
    spec_app [CoreArg]
    rule_lhs_args
                  df :: Unfolding
    df@(DFunUnfolding { df_bndrs :: Unfolding -> [Var]
    df_bndrs = [Var]
    old_bndrs, df_con :: Unfolding -> DataCon
    df_con = DataCon
    con, df_args :: Unfolding -> [CoreArg]
    df_args = [CoreArg]
    args })
      = Bool -> SDoc -> Unfolding -> Unfolding
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr ([CoreArg]
    rule_lhs_args [CoreArg] -> [Var] -> Bool
    forall a b. [a] -> [b] -> Bool
    `equalLength` [Var]
    old_bndrs)
                  (Unfolding -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unfolding
    df SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [CoreArg] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreArg]
    rule_lhs_args) (Unfolding -> Unfolding) -> Unfolding -> Unfolding
    forall a b. (a -> b) -> a -> b
    $
               -- For this ASSERT see Note [Specialising DFuns] in GHC.Core.Opt.Specialise
        [Var] -> DataCon -> [CoreArg] -> Unfolding
    mkDFunUnfolding [Var]
    spec_bndrs DataCon
    con ((CoreArg -> CoreArg) -> [CoreArg] -> [CoreArg]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreArg -> CoreArg
    spec_arg [CoreArg]
    args)
          -- For DFunUnfoldings we transform
          --       \obs. MkD <op1> ... <opn>
          -- to
          --       \sbs. MkD ((\obs. <op1>) spec_args) ... ditto <opn>
      where
        spec_arg :: CoreArg -> CoreArg
    spec_arg CoreArg
    arg = HasDebugCallStack => SimpleOpts -> CoreArg -> CoreArg
    SimpleOpts -> CoreArg -> CoreArg
    simpleOptExpr SimpleOpts
    opts (CoreArg -> CoreArg) -> CoreArg -> CoreArg
    forall a b. (a -> b) -> a -> b
    $
                       CoreArg -> CoreArg
    spec_app ([Var] -> CoreArg -> CoreArg
    forall b. [b] -> Expr b -> Expr b
    mkLams [Var]
    old_bndrs CoreArg
    arg)
                       -- The beta-redexes created by spec_app will be
                       -- simplified away by simplOptExpr
                       -- ToDo: this is VERY DELICATE for type args.  We make
                       --        (\@a @b x y. TYPE ty) ty1 ty2 d1 d2
                       -- and rely on it simplifying to ty[ty1/a, ty2/b]

    specUnfolding SimpleOpts
    opts [Var]
    spec_bndrs CoreArg -> CoreArg
    spec_app [CoreArg]
    rule_lhs_args
                  (CoreUnfolding { uf_src :: Unfolding -> UnfoldingSource
    uf_src = UnfoldingSource
    src, uf_tmpl :: Unfolding -> CoreArg
    uf_tmpl = CoreArg
    tmpl
                                 , uf_is_top :: Unfolding -> Bool
    uf_is_top = Bool
    top_lvl
                                 , uf_guidance :: Unfolding -> UnfoldingGuidance
    uf_guidance = UnfoldingGuidance
    old_guidance })
     | UnfoldingSource -> Bool
    isStableSource UnfoldingSource
    src  -- See Note [Specialising unfoldings]
     , UnfWhen { ug_arity :: UnfoldingGuidance -> ArityInfo
    ug_arity = ArityInfo
    old_arity } <- UnfoldingGuidance
    old_guidance
     = UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    src Bool
    top_lvl CoreArg
    new_tmpl Maybe UnfoldingCache
    forall a. Maybe a
    Nothing
                       (UnfoldingGuidance
    old_guidance { ug_arity = old_arity - arity_decrease })
     where
       new_tmpl :: CoreArg
    new_tmpl = HasDebugCallStack => SimpleOpts -> CoreArg -> CoreArg
    SimpleOpts -> CoreArg -> CoreArg
    simpleOptExpr SimpleOpts
    opts (CoreArg -> CoreArg) -> CoreArg -> CoreArg
    forall a b. (a -> b) -> a -> b
    $
                  [Var] -> CoreArg -> CoreArg
    forall b. [b] -> Expr b -> Expr b
    mkLams [Var]
    spec_bndrs  (CoreArg -> CoreArg) -> CoreArg -> CoreArg
    forall a b. (a -> b) -> a -> b
    $
                  CoreArg -> CoreArg
    spec_app CoreArg
    tmpl  -- The beta-redexes created by spec_app
                                 -- will be simplified away by simplOptExpr
       arity_decrease :: ArityInfo
    arity_decrease = (CoreArg -> Bool) -> [CoreArg] -> ArityInfo
    forall a. (a -> Bool) -> [a] -> ArityInfo
    count CoreArg -> Bool
    forall b. Expr b -> Bool
    isValArg [CoreArg]
    rule_lhs_args ArityInfo -> ArityInfo -> ArityInfo
    forall a. Num a => a -> a -> a
    - (Var -> Bool) -> [Var] -> ArityInfo
    forall a. (a -> Bool) -> [a] -> ArityInfo
    count Var -> Bool
    isId [Var]
    spec_bndrs

    specUnfolding SimpleOpts
    _ [Var]
    _ CoreArg -> CoreArg
    _ [CoreArg]
    _ Unfolding
    _ = Unfolding
    noUnfolding

    {- Note [Specialising unfoldings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we specialise a function for some given type-class arguments, we use
    specUnfolding to specialise its unfolding.  Some important points:

    * If the original function has a DFunUnfolding, the specialised one
      must do so too!  Otherwise we lose the magic rules that make it
      interact with ClassOps

    * For a /stable/ CoreUnfolding, we specialise the unfolding, no matter
      how big, iff it has UnfWhen guidance.  This happens for INLINE
      functions, and for wrappers.  For these, it would be very odd if a
      function marked INLINE was specialised (because of some local use),
      and then forever after (including importing modules) the specialised
      version wasn't INLINEd!  After all, the programmer said INLINE.

    * However, for a stable CoreUnfolding with guidance UnfoldIfGoodArgs,
      which arises from INLINABLE functions, we drop the unfolding.
      See #4874 for persuasive examples.  Suppose we have
        {-# INLINABLE f #-}
        f :: Ord a => [a] -> Int f xs = letrec f' = ...f'... in f'

      Then, when f is specialised and optimised we might get
        wgo :: [Int] -> Int#
        wgo = ...wgo...
        f_spec :: [Int] -> Int
        f_spec xs = case wgo xs of { r -> I# r }

      and we clearly want to inline f_spec at call sites.  But if we still
      have the big, un-optimised of f (albeit specialised) captured in the
      stable unfolding for f_spec, we won't get that optimisation.

      This happens with Control.Monad.liftM3, and can cause a lot more
      allocation as a result (nofib n-body shows this).

      Moreover, keeping the stable unfolding isn't much help, because
      the specialised function (probably) isn't overloaded any more.

      TL;DR: we simply drop the stable unfolding when specialising. It's not
      really a complete solution; ignoring specialisation for now, INLINABLE
      functions don't get properly strictness analysed, for example.
      Moreover, it means that the specialised function has an INLINEABLE
      pragma, but no stable unfolding. But it works well for examples
      involving specialisation, which is the dominant use of INLINABLE.

    Note [Honour INLINE on 0-ary bindings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider

       x = <expensive>
       {-# INLINE x #-}

       f y = ...x...

    The semantics of an INLINE pragma is

      inline x at every call site, provided it is saturated;
      that is, applied to at least as many arguments as appear
      on the LHS of the Haskell source definition.

    (This source-code-derived arity is stored in the `ug_arity` field of
    the `UnfoldingGuidance`.)

    In the example, x's ug_arity is 0, so we should inline it at every use
    site.  It's rare to have such an INLINE pragma (usually INLINE is on
    functions), but it's occasionally very important (#15578, #15519).
    In #15519 we had something like
       x = case (g a b) of I# r -> T r
       {-# INLINE x #-}
       f y = ...(h x)....

    where h is strict.  So we got
       f y = ...(case g a b of I# r -> h (T r))...

    and that in turn allowed SpecConstr to ramp up performance.

    How do we deliver on this?  By adjusting the ug_boring_ok
    flag in mkInlineUnfoldingWithArity; see
    Note [INLINE pragmas and boring contexts]

    NB: there is a real risk that full laziness will float it right back
    out again. Consider again
      x = factorial 200
      {-# INLINE x #-}
      f y = ...x...

    After inlining we get
      f y = ...(factorial 200)...

    but it's entirely possible that full laziness will do
      lvl23 = factorial 200
      f y = ...lvl23...

    That's a problem for another day.

    Note [INLINE pragmas and boring contexts]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    An INLINE pragma uses mkInlineUnfoldingWithArity to build the
    unfolding.  That sets the ug_boring_ok flag to False if the function
    is not tiny (inlineBoringOK), so that even INLINE functions are not
    inlined in an utterly boring context.  E.g.
         \x y. Just (f y x)
    Nothing is gained by inlining f here, even if it has an INLINE
    pragma.

    But for 0-ary bindings, we want to inline regardless; see
    Note [Honour INLINE on 0-ary bindings].

    I'm a bit worried that it's possible for the same kind of problem
    to arise for non-0-ary functions too, but let's wait and see.
    -}

    mkUnfolding :: UnfoldingOpts
                -> UnfoldingSource
                -> Bool       -- Is top-level
                -> Bool       -- Definitely a bottoming binding
                              -- (only relevant for top-level bindings)
                -> Bool       -- True <=> join point
                -> CoreExpr
                -> Maybe UnfoldingCache
                -> Unfolding
    -- Calculates unfolding guidance
    -- Occurrence-analyses the expression before capturing it
    mkUnfolding :: UnfoldingOpts
    -> UnfoldingSource
    -> Bool
    -> Bool
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> Unfolding
    mkUnfolding UnfoldingOpts
    opts UnfoldingSource
    src Bool
    top_lvl Bool
    is_bottoming Bool
    is_join CoreArg
    expr Maybe UnfoldingCache
    cache
      = UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    src Bool
    top_lvl CoreArg
    expr Maybe UnfoldingCache
    cache UnfoldingGuidance
    guidance
      where
        is_top_bottoming :: Bool
    is_top_bottoming = Bool
    top_lvl Bool -> Bool -> Bool
    && Bool
    is_bottoming
        guidance :: UnfoldingGuidance
    guidance         = UnfoldingOpts -> Bool -> Bool -> CoreArg -> UnfoldingGuidance
    calcUnfoldingGuidance UnfoldingOpts
    opts Bool
    is_top_bottoming Bool
    is_join CoreArg
    expr
            -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
            -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]

    mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
                    -> Maybe UnfoldingCache -> UnfoldingGuidance -> Unfolding
    -- Occurrence-analyses the expression before capturing it
    mkCoreUnfolding :: UnfoldingSource
    -> Bool
    -> CoreArg
    -> Maybe UnfoldingCache
    -> UnfoldingGuidance
    -> Unfolding
    mkCoreUnfolding UnfoldingSource
    src Bool
    top_lvl CoreArg
    expr Maybe UnfoldingCache
    precomputed_cache UnfoldingGuidance
    guidance
      = CoreUnfolding { uf_tmpl :: CoreArg
    uf_tmpl = UnfoldingCache
    cache UnfoldingCache -> CoreArg -> CoreArg
    forall a b. a -> b -> b
    `seq`
                                  CoreArg -> CoreArg
    occurAnalyseExpr CoreArg
    expr
          -- occAnalyseExpr: see Note [OccInfo in unfoldings and rules] in GHC.Core
          -- See #20905 for what a discussion of this 'seq'.
          -- We are careful to make sure we only
          -- have one copy of an unfolding around at once.
          -- Note [Thoughtful forcing in mkCoreUnfolding]

                      , uf_src :: UnfoldingSource
    uf_src          = UnfoldingSource
    src
                      , uf_is_top :: Bool
    uf_is_top       = Bool
    top_lvl
                      , uf_cache :: UnfoldingCache
    uf_cache        = UnfoldingCache
    cache
                      , uf_guidance :: UnfoldingGuidance
    uf_guidance     = UnfoldingGuidance
    guidance }
      where
        is_value :: Bool
    is_value      = CoreArg -> Bool
    exprIsHNF CoreArg
    expr
        is_conlike :: Bool
    is_conlike    = CoreArg -> Bool
    exprIsConLike CoreArg
    expr
        is_work_free :: Bool
    is_work_free  = CoreArg -> Bool
    exprIsWorkFree CoreArg
    expr
        is_expandable :: Bool
    is_expandable = CoreArg -> Bool
    exprIsExpandable CoreArg
    expr

        recomputed_cache :: UnfoldingCache
    recomputed_cache = UnfoldingCache { uf_is_value :: Bool
    uf_is_value = Bool
    is_value
                                          , uf_is_conlike :: Bool
    uf_is_conlike = Bool
    is_conlike
                                          , uf_is_work_free :: Bool
    uf_is_work_free = Bool
    is_work_free
                                          , uf_expandable :: Bool
    uf_expandable = Bool
    is_expandable }

        cache :: UnfoldingCache
    cache = UnfoldingCache -> Maybe UnfoldingCache -> UnfoldingCache
    forall a. a -> Maybe a -> a
    fromMaybe UnfoldingCache
    recomputed_cache Maybe UnfoldingCache
    precomputed_cache

    ----------------
    certainlyWillInline :: UnfoldingOpts -> IdInfo -> CoreExpr -> Maybe Unfolding
    -- ^ Sees if the unfolding is pretty certain to inline.
    -- If so, return a *stable* unfolding for it, that will always inline.
    -- The CoreExpr is the WW'd and simplified RHS. In contrast, the unfolding
    -- template might not have been WW'd yet.
    certainlyWillInline :: UnfoldingOpts -> IdInfo -> CoreArg -> Maybe Unfolding
    certainlyWillInline UnfoldingOpts
    opts IdInfo
    fn_info CoreArg
    rhs'
      = case Unfolding
    fn_unf of
          CoreUnfolding { uf_guidance :: Unfolding -> UnfoldingGuidance
    uf_guidance = UnfoldingGuidance
    guidance, uf_src :: Unfolding -> UnfoldingSource
    uf_src = UnfoldingSource
    src }
            | 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 = src', uf_tmpl = tmpl' })
                                 -- INLINE functions have UnfWhen
                 UnfIfGoodArgs { ug_size :: UnfoldingGuidance -> ArityInfo
    ug_size = ArityInfo
    size, ug_args :: UnfoldingGuidance -> [ArityInfo]
    ug_args = [ArityInfo]
    args }
                            -> ArityInfo
    -> [ArityInfo] -> UnfoldingSource -> CoreArg -> Maybe Unfolding
    do_cunf ArityInfo
    size [ArityInfo]
    args UnfoldingSource
    src' CoreArg
    tmpl'
            where
              src' :: UnfoldingSource
    src' | UnfoldingSource -> Bool
    isCompulsorySource UnfoldingSource
    src = UnfoldingSource
    src  -- Do not change InlineCompulsory!
                   | Bool
    otherwise              = UnfoldingSource
    StableSystemSrc

              tmpl' :: CoreArg
    tmpl' | UnfoldingSource -> Bool
    isStableSource UnfoldingSource
    src = Unfolding -> CoreArg
    uf_tmpl Unfolding
    fn_unf
                    | Bool
    otherwise          = CoreArg -> CoreArg
    occurAnalyseExpr CoreArg
    rhs'
                    -- Do not overwrite stable unfoldings!

          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
        noinline :: Bool
    noinline = InlinePragma -> Bool
    isNoInlinePragma (IdInfo -> InlinePragma
    inlinePragInfo IdInfo
    fn_info)
        fn_unf :: Unfolding
    fn_unf   = IdInfo -> Unfolding
    unfoldingInfo IdInfo
    fn_info -- NB: loop-breakers never inline

            -- 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 :: ArityInfo
    -> [ArityInfo] -> UnfoldingSource -> CoreArg -> Maybe Unfolding
    do_cunf ArityInfo
    size [ArityInfo]
    args UnfoldingSource
    src' CoreArg
    tmpl'
          | IdInfo -> ArityInfo
    arityInfo IdInfo
    fn_info ArityInfo -> ArityInfo -> Bool
    forall a. Ord a => a -> a -> Bool
    > ArityInfo
    0  -- See Note [certainlyWillInline: be careful of thunks]
          , Bool -> Bool
    not (DmdSig -> Bool
    isDeadEndSig (IdInfo -> DmdSig
    dmdSigInfo 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 :: ArityInfo
    unf_arity = [ArityInfo] -> ArityInfo
    forall a. [a] -> ArityInfo
    forall (t :: * -> *) a. Foldable t => t a -> ArityInfo
    length [ArityInfo]
    args
          , ArityInfo
    size ArityInfo -> ArityInfo -> ArityInfo
    forall a. Num a => a -> a -> a
    - (ArityInfo
    10 ArityInfo -> ArityInfo -> ArityInfo
    forall a. Num a => a -> a -> a
    * (ArityInfo
    unf_arity ArityInfo -> ArityInfo -> ArityInfo
    forall a. Num a => a -> a -> a
    + ArityInfo
    1)) ArityInfo -> ArityInfo -> Bool
    forall a. Ord a => a -> a -> Bool
    <= UnfoldingOpts -> ArityInfo
    unfoldingUseThreshold UnfoldingOpts
    opts
          = Unfolding -> Maybe Unfolding
    forall a. a -> Maybe a
    Just (Unfolding
    fn_unf { uf_src      = src'
                         , uf_tmpl     = tmpl'
                         , uf_guidance = UnfWhen { ug_arity     = unf_arity
                                                 , ug_unsat_ok  = unSaturatedOk
                                                 , ug_boring_ok = inlineBoringOk tmpl' } })
                 -- 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]

    Note [Thoughtful forcing in mkCoreUnfolding]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Core expressions retained in unfoldings is one of biggest uses of memory when compiling
    a program. Therefore we have to be careful about retaining copies of old or redundant
    templates (see !6202 for a particularly bad case).

    With that in mind we want to maintain the invariant that each unfolding only references
    a single CoreExpr. One place where we have to be careful is in mkCoreUnfolding.

    * The template of the unfolding is the result of performing occurrence analysis
      (Note [OccInfo in unfoldings and rules] in GHC.Core)
    * Predicates are applied to the unanalysed expression

    Therefore if we are not thoughtful about forcing you can end up in a situation where the
    template is forced but not all the predicates are forced so the unfolding will retain
    both the old and analysed expressions.

    I investigated this using ghc-debug and it was clear this situation did often arise:

    ```
    (["ghc:GHC.Core:Lam","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 4307)
    ```

    Here the predicates are unforced but the template is forced.

    Therefore we basically had two options in order to fix this:

    1. Perform the predicates on the analysed expression.
    2. Force the predicates to remove retainer to the old expression if we force the template.

    Option 1 is bad because occurrence analysis is expensive and destroys any sharing of the unfolding
    with the actual program. (Testing this approach showed peak 25G memory usage)

    Therefore we got for Option 2 which performs a little more work but compensates by
    reducing memory pressure.

    The result of fixing this led to a 1G reduction in peak memory usage (12G -> 11G) when
    compiling a very large module (peak 3 million terms). For more discussion see #20905.
    -}