    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    -}

    module GHC.Core.SimpleOpt (
            SimpleOpts (..), defaultSimpleOpts,

            -- ** Simple expression optimiser
            simpleOptPgm, simpleOptExpr, simpleOptExprWith,

            -- ** Join points
            joinPointBinding_maybe, joinPointBindings_maybe,

            -- ** Predicates on expressions
            exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe,

        ) where

    import GHC.Prelude

    import GHC.Core
    import GHC.Core.Opt.Arity
    import GHC.Core.Subst
    import GHC.Core.Utils
    import GHC.Core.FVs
    import GHC.Core.Unfold
    import GHC.Core.Unfold.Make
    import GHC.Core.Make ( FloatBind(..), mkWildValBinder )
    import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs )
    import GHC.Core.DataCon
    import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) )
    import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
                                , isInScope, substTyVarBndr, cloneTyVarBndr )
    import GHC.Core.Predicate( isCoVarType )
    import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )

    import GHC.Types.Literal
    import GHC.Types.Id
    import GHC.Types.Id.Info  ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) )
    import GHC.Types.Var      ( isNonCoVarId )
    import GHC.Types.Var.Set
    import GHC.Types.Var.Env
    import GHC.Types.Demand( etaConvertDmdSig, topSubDmd )
    import GHC.Types.Tickish
    import GHC.Types.Basic

    import GHC.Builtin.Types
    import GHC.Builtin.Names

    import GHC.Unit.Module ( Module )
    import GHC.Utils.Encoding
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc

    import GHC.Data.Maybe       ( orElse )
    import GHC.Data.Graph.UnVar
    import Data.List (mapAccumL)
    import qualified Data.ByteString as BS

    {-
    ************************************************************************
    *                                                                      *
            The Simple Optimiser
    *                                                                      *
    ************************************************************************

    Note [The simple optimiser]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The simple optimiser is a lightweight, pure (non-monadic) function
    that rapidly does a lot of simple optimisations, including

      - inlining things that occur just once,
          or whose RHS turns out to be trivial
      - beta reduction
      - case of known constructor
      - dead code elimination

    It does NOT do any call-site inlining; it only inlines a function if
    it can do so unconditionally, dropping the binding.  It thereby
    guarantees to leave no un-reduced beta-redexes.

    It is careful to follow the guidance of "Secrets of the GHC inliner",
    and in particular the pre-inline-unconditionally and
    post-inline-unconditionally story, to do effective beta reduction on
    functions called precisely once, without repeatedly optimising the same
    expression.  In fact, the simple optimiser is a good example of this
    little dance in action; the full Simplifier is a lot more complicated.

    -}

    -- | Simple optimiser options
    data SimpleOpts = SimpleOpts
       { SimpleOpts -> UnfoldingOpts
    so_uf_opts :: !UnfoldingOpts   -- ^ Unfolding options
       , SimpleOpts -> OptCoercionOpts
    so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
       , SimpleOpts -> Bool
    so_eta_red :: !Bool            -- ^ Eta reduction on?
       }

    -- | Default options for the Simple optimiser.
    defaultSimpleOpts :: SimpleOpts
    defaultSimpleOpts :: SimpleOpts
    defaultSimpleOpts = SimpleOpts
       { so_uf_opts :: UnfoldingOpts
    so_uf_opts = UnfoldingOpts
    defaultUnfoldingOpts
       , so_co_opts :: OptCoercionOpts
    so_co_opts = OptCoercionOpts { optCoercionEnabled :: Bool
    optCoercionEnabled = Bool
    False }
       , so_eta_red :: Bool
    so_eta_red = Bool
    False
       }

    simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
    -- See Note [The simple optimiser]
    -- Do simple optimisation on an expression
    -- The optimisation is very straightforward: just
    -- inline non-recursive bindings that are used only once,
    -- or where the RHS is trivial
    --
    -- We also inline bindings that bind a Eq# box: see
    -- See Note [Getting the map/coerce RULE to work].
    --
    -- Also we convert functions to join points where possible (as
    -- the occurrence analyser does most of the work anyway).
    --
    -- The result is NOT guaranteed occurrence-analysed, because
    -- in  (let x = y in ....) we substitute for x; so y's occ-info
    -- may change radically
    --
    -- Note that simpleOptExpr is a pure function that we want to be able to call
    -- from lots of places, including ones that don't have DynFlags (e.g to optimise
    -- unfoldings of statically defined Ids via mkCompulsoryUnfolding). It used to
    -- fetch its options directly from the DynFlags, however, so some callers had to
    -- resort to using unsafeGlobalDynFlags (a global mutable variable containing
    -- the DynFlags). It has been modified to take its own SimpleOpts that may be
    -- created from DynFlags, but not necessarily.

    simpleOptExpr :: HasDebugCallStack => SimpleOpts -> OutExpr -> OutExpr
    simpleOptExpr SimpleOpts
    opts OutExpr
    expr
      = -- pprTrace "simpleOptExpr" (ppr init_subst $$ ppr expr)
        HasDebugCallStack => SimpleOpts -> Subst -> OutExpr -> OutExpr
    SimpleOpts -> Subst -> OutExpr -> OutExpr
    simpleOptExprWith SimpleOpts
    opts Subst
    init_subst OutExpr
    expr
      where
        init_subst :: Subst
    init_subst = InScopeSet -> Subst
    mkEmptySubst (VarSet -> InScopeSet
    mkInScopeSet (OutExpr -> VarSet
    exprFreeVars OutExpr
    expr))
            -- It's potentially important to make a proper in-scope set
            -- Consider  let x = ..y.. in \y. ...x...
            -- Then we should remember to clone y before substituting
            -- for x.  It's very unlikely to occur, because we probably
            -- won't *be* substituting for x if it occurs inside a
            -- lambda.
            --
            -- It's a bit painful to call exprFreeVars, because it makes
            -- three passes instead of two (occ-anal, and go)

    simpleOptExprWith :: HasDebugCallStack => SimpleOpts -> Subst -> InExpr -> OutExpr
    -- See Note [The simple optimiser]
    simpleOptExprWith :: HasDebugCallStack => SimpleOpts -> Subst -> OutExpr -> OutExpr
    simpleOptExprWith SimpleOpts
    opts Subst
    subst OutExpr
    expr
      = HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    init_env (OutExpr -> OutExpr
    occurAnalyseExpr OutExpr
    expr)
      where
        init_env :: SimpleOptEnv
    init_env = (SimpleOpts -> SimpleOptEnv
    emptyEnv SimpleOpts
    opts) { soe_subst = subst }

    ----------------------
    simpleOptPgm :: SimpleOpts
                 -> Module
                 -> CoreProgram
                 -> [CoreRule]
                 -> (CoreProgram, [CoreRule], CoreProgram)
    -- See Note [The simple optimiser]
    simpleOptPgm :: SimpleOpts
    -> Module
    -> CoreProgram
    -> [CoreRule]
    -> (CoreProgram, [CoreRule], CoreProgram)
    simpleOptPgm SimpleOpts
    opts Module
    this_mod CoreProgram
    binds [CoreRule]
    rules =
        (CoreProgram -> CoreProgram
    forall a. [a] -> [a]
    reverse CoreProgram
    binds', [CoreRule]
    rules', CoreProgram
    occ_anald_binds)
      where
        occ_anald_binds :: CoreProgram
    occ_anald_binds  = Module
    -> (Id -> Bool)
    -> (Activation -> Bool)
    -> [CoreRule]
    -> CoreProgram
    -> CoreProgram
    occurAnalysePgm Module
    this_mod
                              (\Id
    _ -> Bool
    True)  {- All unfoldings active -}
                              (\Activation
    _ -> Bool
    False) {- No rules active -}
                              [CoreRule]
    rules CoreProgram
    binds

        (SimpleOptEnv
    final_env, CoreProgram
    binds') = ((SimpleOptEnv, CoreProgram)
     -> InBind -> (SimpleOptEnv, CoreProgram))
    -> (SimpleOptEnv, CoreProgram)
    -> CoreProgram
    -> (SimpleOptEnv, CoreProgram)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (SimpleOptEnv, CoreProgram)
    -> InBind -> (SimpleOptEnv, CoreProgram)
    do_one (SimpleOpts -> SimpleOptEnv
    emptyEnv SimpleOpts
    opts, []) CoreProgram
    occ_anald_binds
        final_subst :: Subst
    final_subst = SimpleOptEnv -> Subst
    soe_subst SimpleOptEnv
    final_env

        rules' :: [CoreRule]
    rules' = Subst -> [CoreRule] -> [CoreRule]
    substRulesForImportedIds Subst
    final_subst [CoreRule]
    rules
                 -- We never unconditionally inline into rules,
                 -- hence paying just a substitution

        do_one :: (SimpleOptEnv, CoreProgram)
    -> InBind -> (SimpleOptEnv, CoreProgram)
    do_one (SimpleOptEnv
    env, CoreProgram
    binds') InBind
    bind
          = case SimpleOptEnv
    -> InBind -> TopLevelFlag -> (SimpleOptEnv, Maybe InBind)
    simple_opt_bind SimpleOptEnv
    env InBind
    bind TopLevelFlag
    TopLevel of
              (SimpleOptEnv
    env', Maybe InBind
    Nothing)    -> (SimpleOptEnv
    env', CoreProgram
    binds')
              (SimpleOptEnv
    env', Just InBind
    bind') -> (SimpleOptEnv
    env', InBind
    bind'InBind -> CoreProgram -> CoreProgram
    forall a. a -> [a] -> [a]
    :CoreProgram
    binds')

    -- In these functions the substitution maps InVar -> OutExpr

    ----------------------
    type SimpleClo = (SimpleOptEnv, InExpr)

    data SimpleOptEnv
      = SOE { SimpleOptEnv -> SimpleOpts
    soe_opts :: {-# UNPACK #-} !SimpleOpts
                 -- ^ Simplifier options

            , SimpleOptEnv -> IdEnv SimpleClo
    soe_inl :: IdEnv SimpleClo
                 -- ^ Deals with preInlineUnconditionally; things
                 -- that occur exactly once and are inlined
                 -- without having first been simplified

            , SimpleOptEnv -> Subst
    soe_subst :: Subst
                 -- ^ Deals with cloning; includes the InScopeSet

            , SimpleOptEnv -> UnVarSet
    soe_rec_ids :: !UnVarSet
                 -- ^ Fast OutVarSet tracking which recursive RHSs we are analysing.
                 -- See Note [Eta reduction in recursive RHSs]
            }

    instance Outputable SimpleOptEnv where
      ppr :: SimpleOptEnv -> SDoc
    ppr (SOE { soe_inl :: SimpleOptEnv -> IdEnv SimpleClo
    soe_inl = IdEnv SimpleClo
    inl, soe_subst :: SimpleOptEnv -> Subst
    soe_subst = Subst
    subst })
        = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "SOE {" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "soe_inl   =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> IdEnv SimpleClo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr IdEnv SimpleClo
    inl
                                , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "soe_subst =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Subst -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Subst
    subst ]
                       SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "}"

    emptyEnv :: SimpleOpts -> SimpleOptEnv
    emptyEnv :: SimpleOpts -> SimpleOptEnv
    emptyEnv SimpleOpts
    opts = SOE { soe_inl :: IdEnv SimpleClo
    soe_inl     = IdEnv SimpleClo
    forall a. VarEnv a
    emptyVarEnv
                        , soe_subst :: Subst
    soe_subst   = Subst
    emptySubst
                        , soe_rec_ids :: UnVarSet
    soe_rec_ids = UnVarSet
    emptyUnVarSet
                        , soe_opts :: SimpleOpts
    soe_opts    = SimpleOpts
    opts  }

    soeZapSubst :: SimpleOptEnv -> SimpleOptEnv
    soeZapSubst :: SimpleOptEnv -> SimpleOptEnv
    soeZapSubst env :: SimpleOptEnv
    env@(SOE { soe_subst :: SimpleOptEnv -> Subst
    soe_subst = Subst
    subst })
      = SimpleOptEnv
    env { soe_inl = emptyVarEnv, soe_subst = zapSubst subst }

    soeInScope :: SimpleOptEnv -> InScopeSet
    soeInScope :: SimpleOptEnv -> InScopeSet
    soeInScope (SOE { soe_subst :: SimpleOptEnv -> Subst
    soe_subst = Subst
    subst }) = Subst -> InScopeSet
    getSubstInScope Subst
    subst

    soeSetInScope :: InScopeSet -> SimpleOptEnv -> SimpleOptEnv
    soeSetInScope :: InScopeSet -> SimpleOptEnv -> SimpleOptEnv
    soeSetInScope InScopeSet
    in_scope env2 :: SimpleOptEnv
    env2@(SOE { soe_subst :: SimpleOptEnv -> Subst
    soe_subst = Subst
    subst2 })
      = SimpleOptEnv
    env2 { soe_subst = setInScope subst2 in_scope }

    enterRecGroupRHSs :: SimpleOptEnv -> [OutBndr] -> (SimpleOptEnv -> (SimpleOptEnv, r))
                      -> (SimpleOptEnv, r)
    enterRecGroupRHSs :: forall r.
    SimpleOptEnv
    -> [Id] -> (SimpleOptEnv -> (SimpleOptEnv, r)) -> (SimpleOptEnv, r)
    enterRecGroupRHSs SimpleOptEnv
    env [Id]
    bndrs SimpleOptEnv -> (SimpleOptEnv, r)
    k
      = (SimpleOptEnv
    env'{soe_rec_ids = soe_rec_ids env}, r
    r)
      where
        (SimpleOptEnv
    env', r
    r) = SimpleOptEnv -> (SimpleOptEnv, r)
    k SimpleOptEnv
    env{soe_rec_ids = extendUnVarSetList bndrs (soe_rec_ids env)}

    ---------------
    simple_opt_clo :: HasDebugCallStack
                   => InScopeSet
                   -> SimpleClo
                   -> OutExpr
    simple_opt_clo :: HasDebugCallStack => InScopeSet -> SimpleClo -> OutExpr
    simple_opt_clo InScopeSet
    in_scope (SimpleOptEnv
    e_env, OutExpr
    e)
      = HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr (InScopeSet -> SimpleOptEnv -> SimpleOptEnv
    soeSetInScope InScopeSet
    in_scope SimpleOptEnv
    e_env) OutExpr
    e

    simple_opt_expr :: HasDebugCallStack => SimpleOptEnv -> InExpr -> OutExpr
    simple_opt_expr :: HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env OutExpr
    expr
      = OutExpr -> OutExpr
    go OutExpr
    expr
      where
        rec_ids :: UnVarSet
    rec_ids      = SimpleOptEnv -> UnVarSet
    soe_rec_ids SimpleOptEnv
    env
        subst :: Subst
    subst        = SimpleOptEnv -> Subst
    soe_subst SimpleOptEnv
    env
        in_scope :: InScopeSet
    in_scope     = Subst -> InScopeSet
    getSubstInScope Subst
    subst
        in_scope_env :: InScopeEnv
    in_scope_env = InScopeSet -> IdUnfoldingFun -> InScopeEnv
    ISE InScopeSet
    in_scope IdUnfoldingFun
    alwaysActiveUnfoldingFun

        ---------------
        go :: OutExpr -> OutExpr
    go (Var Id
    v)
           | Just SimpleClo
    clo <- IdEnv SimpleClo -> Id -> Maybe SimpleClo
    forall a. VarEnv a -> Id -> Maybe a
    lookupVarEnv (SimpleOptEnv -> IdEnv SimpleClo
    soe_inl SimpleOptEnv
    env) Id
    v
           = HasDebugCallStack => InScopeSet -> SimpleClo -> OutExpr
    InScopeSet -> SimpleClo -> OutExpr
    simple_opt_clo InScopeSet
    in_scope SimpleClo
    clo
           | Bool
    otherwise
           = HasDebugCallStack => Subst -> Id -> OutExpr
    Subst -> Id -> OutExpr
    lookupIdSubst (SimpleOptEnv -> Subst
    soe_subst SimpleOptEnv
    env) Id
    v

        go (App OutExpr
    e1 OutExpr
    e2)      = HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app SimpleOptEnv
    env OutExpr
    e1 [(SimpleOptEnv
    env,OutExpr
    e2)]
        go (Type Type
    ty)        = Type -> OutExpr
    forall b. Type -> Expr b
    Type     (Subst -> Type -> Type
    substTyUnchecked Subst
    subst Type
    ty)
        go (Coercion Coercion
    co)    = Coercion -> OutExpr
    forall b. Coercion -> Expr b
    Coercion (Coercion -> Coercion
    go_co Coercion
    co)
        go (Lit Literal
    lit)        = Literal -> OutExpr
    forall b. Literal -> Expr b
    Lit Literal
    lit
        go (Tick CoreTickish
    tickish OutExpr
    e) = CoreTickish -> OutExpr -> OutExpr
    mkTick (Subst -> CoreTickish -> CoreTickish
    substTickish Subst
    subst CoreTickish
    tickish) (OutExpr -> OutExpr
    go OutExpr
    e)
        go (Cast OutExpr
    e Coercion
    co)      = OutExpr -> Coercion -> OutExpr
    mk_cast (OutExpr -> OutExpr
    go OutExpr
    e) (Coercion -> Coercion
    go_co Coercion
    co)
        go (Let InBind
    bind OutExpr
    body)  = case SimpleOptEnv
    -> InBind -> TopLevelFlag -> (SimpleOptEnv, Maybe InBind)
    simple_opt_bind SimpleOptEnv
    env InBind
    bind TopLevelFlag
    NotTopLevel of
                                 (SimpleOptEnv
    env', Maybe InBind
    Nothing)   -> HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env' OutExpr
    body
                                 (SimpleOptEnv
    env', Just InBind
    bind) -> InBind -> OutExpr -> OutExpr
    forall b. Bind b -> Expr b -> Expr b
    Let InBind
    bind (HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env' OutExpr
    body)

        go lam :: OutExpr
    lam@(Lam {})     = SimpleOptEnv -> [Id] -> OutExpr -> OutExpr
    go_lam SimpleOptEnv
    env [] OutExpr
    lam
        go (Case OutExpr
    e Id
    b Type
    ty [Alt Id]
    as)
          | Id -> Bool
    isDeadBinder Id
    b
          , Just (InScopeSet
    _, [], DataCon
    con, [Type]
    _tys, [OutExpr]
    es) <- HasDebugCallStack =>
    InScopeEnv
    -> OutExpr
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    InScopeEnv
    -> OutExpr
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    exprIsConApp_maybe InScopeEnv
    in_scope_env OutExpr
    e'
            -- We don't need to be concerned about floats when looking for coerce.
          , Just (Alt AltCon
    altcon [Id]
    bs OutExpr
    rhs) <- AltCon -> [Alt Id] -> Maybe (Alt Id)
    forall b. AltCon -> [Alt b] -> Maybe (Alt b)
    findAlt (DataCon -> AltCon
    DataAlt DataCon
    con) [Alt Id]
    as
          = case AltCon
    altcon of
              AltCon
    DEFAULT -> OutExpr -> OutExpr
    go OutExpr
    rhs
              AltCon
    _       -> (Maybe (Id, OutExpr) -> OutExpr -> OutExpr)
    -> OutExpr -> [Maybe (Id, OutExpr)] -> OutExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Maybe (Id, OutExpr) -> OutExpr -> OutExpr
    wrapLet (HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env' OutExpr
    rhs) [Maybe (Id, OutExpr)]
    mb_prs
                where
                  (SimpleOptEnv
    env', [Maybe (Id, OutExpr)]
    mb_prs) = (SimpleOptEnv
     -> (Id, OutExpr) -> (SimpleOptEnv, Maybe (Id, OutExpr)))
    -> SimpleOptEnv
    -> [(Id, OutExpr)]
    -> (SimpleOptEnv, [Maybe (Id, OutExpr)])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL (TopLevelFlag
    -> SimpleOptEnv
    -> (Id, OutExpr)
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_out_bind TopLevelFlag
    NotTopLevel) SimpleOptEnv
    env ([(Id, OutExpr)] -> (SimpleOptEnv, [Maybe (Id, OutExpr)]))
    -> [(Id, OutExpr)] -> (SimpleOptEnv, [Maybe (Id, OutExpr)])
    forall a b. (a -> b) -> a -> b
    $
                                   String -> [Id] -> [OutExpr] -> [(Id, OutExpr)]
    forall a b. HasDebugCallStack => String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "simpleOptExpr" [Id]
    bs [OutExpr]
    es

             -- See Note [Getting the map/coerce RULE to work]
          | Id -> Bool
    isDeadBinder Id
    b
          , [Alt AltCon
    DEFAULT [Id]
    _ OutExpr
    rhs] <- [Alt Id]
    as
          , Type -> Bool
    isCoVarType (Id -> Type
    varType Id
    b)
          , (Var Id
    fun, [OutExpr]
    _args) <- OutExpr -> (OutExpr, [OutExpr])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs OutExpr
    e
          , Id
    fun Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    coercibleSCSelIdKey
             -- without this last check, we get #11230
          = OutExpr -> OutExpr
    go OutExpr
    rhs

          | Bool
    otherwise
          = OutExpr -> Id -> Type -> [Alt Id] -> OutExpr
    forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case OutExpr
    e' Id
    b' (Subst -> Type -> Type
    substTyUnchecked Subst
    subst Type
    ty)
                       ((Alt Id -> Alt Id) -> [Alt Id] -> [Alt Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (SimpleOptEnv -> Alt Id -> Alt Id
    go_alt SimpleOptEnv
    env') [Alt Id]
    as)
          where
            e' :: OutExpr
    e' = OutExpr -> OutExpr
    go OutExpr
    e
            (SimpleOptEnv
    env', Id
    b') = SimpleOptEnv -> Id -> (SimpleOptEnv, Id)
    subst_opt_bndr SimpleOptEnv
    env Id
    b

        ----------------------
        go_co :: Coercion -> Coercion
    go_co Coercion
    co = OptCoercionOpts -> Subst -> Coercion -> Coercion
    optCoercion (SimpleOpts -> OptCoercionOpts
    so_co_opts (SimpleOptEnv -> SimpleOpts
    soe_opts SimpleOptEnv
    env)) Subst
    subst Coercion
    co

        ----------------------
        go_alt :: SimpleOptEnv -> Alt Id -> Alt Id
    go_alt SimpleOptEnv
    env (Alt AltCon
    con [Id]
    bndrs OutExpr
    rhs)
          = AltCon -> [Id] -> OutExpr -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [Id]
    bndrs' (HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env' OutExpr
    rhs)
          where
            (SimpleOptEnv
    env', [Id]
    bndrs') = SimpleOptEnv -> [Id] -> (SimpleOptEnv, [Id])
    subst_opt_bndrs SimpleOptEnv
    env [Id]
    bndrs

        ----------------------
        -- go_lam tries eta reduction
        -- It is quite important that it does so. I tried removing this code and
        -- got a lot of regressions, e.g., +11% ghc/alloc in T18223 and many
        -- run/alloc increases. Presumably RULEs are affected.
        go_lam :: SimpleOptEnv -> [Id] -> OutExpr -> OutExpr
    go_lam SimpleOptEnv
    env [Id]
    bs' (Lam Id
    b OutExpr
    e)
           = SimpleOptEnv -> [Id] -> OutExpr -> OutExpr
    go_lam SimpleOptEnv
    env' (Id
    b'Id -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :[Id]
    bs') OutExpr
    e
           where
             (SimpleOptEnv
    env', Id
    b') = SimpleOptEnv -> Id -> (SimpleOptEnv, Id)
    subst_opt_bndr SimpleOptEnv
    env Id
    b
        go_lam SimpleOptEnv
    env [Id]
    bs' OutExpr
    e
           | SimpleOpts -> Bool
    so_eta_red (SimpleOptEnv -> SimpleOpts
    soe_opts SimpleOptEnv
    env)
           , Just OutExpr
    etad_e <- UnVarSet -> [Id] -> OutExpr -> SubDemand -> Maybe OutExpr
    tryEtaReduce UnVarSet
    rec_ids [Id]
    bs OutExpr
    e' SubDemand
    topSubDmd = OutExpr
    etad_e
           | Bool
    otherwise                                           = [Id] -> OutExpr -> OutExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [Id]
    bs OutExpr
    e'
           where
             bs :: [Id]
    bs = [Id] -> [Id]
    forall a. [a] -> [a]
    reverse [Id]
    bs'
             e' :: OutExpr
    e' = HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env OutExpr
    e

    mk_cast :: CoreExpr -> CoercionR -> CoreExpr
    -- Like GHC.Core.Utils.mkCast, but does a full reflexivity check.
    -- mkCast doesn't do that because the Simplifier does (in simplCast)
    -- But in SimpleOpt it's nice to kill those nested casts (#18112)
    mk_cast :: OutExpr -> Coercion -> OutExpr
    mk_cast (Cast OutExpr
    e Coercion
    co1) Coercion
    co2        = OutExpr -> Coercion -> OutExpr
    mk_cast OutExpr
    e (Coercion
    co1 HasDebugCallStack => Coercion -> Coercion -> Coercion
    Coercion -> Coercion -> Coercion
    `mkTransCo` Coercion
    co2)
    mk_cast (Tick CoreTickish
    t OutExpr
    e)   Coercion
    co         = CoreTickish -> OutExpr -> OutExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t (OutExpr -> Coercion -> OutExpr
    mk_cast OutExpr
    e Coercion
    co)
    mk_cast OutExpr
    e Coercion
    co | Coercion -> Bool
    isReflexiveCo Coercion
    co = OutExpr
    e
                 | Bool
    otherwise        = OutExpr -> Coercion -> OutExpr
    forall b. Expr b -> Coercion -> Expr b
    Cast OutExpr
    e Coercion
    co

    ----------------------
    -- simple_app collects arguments for beta reduction
    simple_app :: HasDebugCallStack => SimpleOptEnv -> InExpr -> [SimpleClo] -> CoreExpr

    simple_app :: HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app SimpleOptEnv
    env (Var Id
    v) [SimpleClo]
    as
      | Just (SimpleOptEnv
    env', OutExpr
    e) <- IdEnv SimpleClo -> Id -> Maybe SimpleClo
    forall a. VarEnv a -> Id -> Maybe a
    lookupVarEnv (SimpleOptEnv -> IdEnv SimpleClo
    soe_inl SimpleOptEnv
    env) Id
    v
      = HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app (InScopeSet -> SimpleOptEnv -> SimpleOptEnv
    soeSetInScope (SimpleOptEnv -> InScopeSet
    soeInScope SimpleOptEnv
    env) SimpleOptEnv
    env') OutExpr
    e [SimpleClo]
    as

      | let unf :: Unfolding
    unf = IdUnfoldingFun
    idUnfolding Id
    v
      , Unfolding -> Bool
    isCompulsoryUnfolding (IdUnfoldingFun
    idUnfolding Id
    v)
      , Activation -> Bool
    isAlwaysActive (Id -> Activation
    idInlineActivation Id
    v)
        -- See Note [Unfold compulsory unfoldings in RULE LHSs]
      = HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app (SimpleOptEnv -> SimpleOptEnv
    soeZapSubst SimpleOptEnv
    env) (Unfolding -> OutExpr
    unfoldingTemplate Unfolding
    unf) [SimpleClo]
    as

      | Bool
    otherwise
      , let out_fn :: OutExpr
    out_fn = HasDebugCallStack => Subst -> Id -> OutExpr
    Subst -> Id -> OutExpr
    lookupIdSubst (SimpleOptEnv -> Subst
    soe_subst SimpleOptEnv
    env) Id
    v
      = HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    finish_app SimpleOptEnv
    env OutExpr
    out_fn [SimpleClo]
    as

    simple_app SimpleOptEnv
    env (App OutExpr
    e1 OutExpr
    e2) [SimpleClo]
    as
      = HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app SimpleOptEnv
    env OutExpr
    e1 ((SimpleOptEnv
    env, OutExpr
    e2) SimpleClo -> [SimpleClo] -> [SimpleClo]
    forall a. a -> [a] -> [a]
    : [SimpleClo]
    as)

    simple_app SimpleOptEnv
    env e :: OutExpr
    e@(Lam {}) as :: [SimpleClo]
    as@(SimpleClo
    _:[SimpleClo]
    _)
      = SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    do_beta SimpleOptEnv
    env (OutExpr -> BranchCount -> OutExpr
    zapLambdaBndrs OutExpr
    e BranchCount
    n_args) [SimpleClo]
    as
        -- Be careful to zap the lambda binders if necessary
        -- c.f. the Lam case of simplExprF1 in GHC.Core.Opt.Simplify
        -- Lacking this zap caused #19347, when we had a redex
        --   (\ a b. K a b) e1 e2
        -- where (as it happens) the eta-expanded K is produced by
        -- Note [Typechecking data constructors] in GHC.Tc.Gen.Head
      where
        n_args :: BranchCount
    n_args = [SimpleClo] -> BranchCount
    forall a. [a] -> BranchCount
    forall (t :: * -> *) a. Foldable t => t a -> BranchCount
    length [SimpleClo]
    as

        do_beta :: SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    do_beta SimpleOptEnv
    env (Lam Id
    b OutExpr
    body) (SimpleClo
    a:[SimpleClo]
    as)
          | -- simpl binder before looking at its type
            -- See Note [Dark corner with representation polymorphism]
            HasDebugCallStack => Type -> OutExpr -> Bool
    Type -> OutExpr -> Bool
    needsCaseBinding (Id -> Type
    idType Id
    b') (SimpleClo -> OutExpr
    forall a b. (a, b) -> b
    snd SimpleClo
    a)
            -- This arg must not be inlined (side-effects) and cannot be let-bound,
            -- due to the let-can-float invariant. So simply case-bind it here.
          , let a' :: OutExpr
    a' = HasDebugCallStack => InScopeSet -> SimpleClo -> OutExpr
    InScopeSet -> SimpleClo -> OutExpr
    simple_opt_clo (SimpleOptEnv -> InScopeSet
    soeInScope SimpleOptEnv
    env) SimpleClo
    a
          = OutExpr -> Id -> OutExpr -> OutExpr
    mkDefaultCase OutExpr
    a' Id
    b' (OutExpr -> OutExpr) -> OutExpr -> OutExpr
    forall a b. (a -> b) -> a -> b
    $ SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    do_beta SimpleOptEnv
    env' OutExpr
    body [SimpleClo]
    as

          | (SimpleOptEnv
    env'', Maybe (Id, OutExpr)
    mb_pr) <- SimpleOptEnv
    -> Id
    -> Maybe Id
    -> SimpleClo
    -> TopLevelFlag
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_bind_pair SimpleOptEnv
    env' Id
    b (Id -> Maybe Id
    forall a. a -> Maybe a
    Just Id
    b') SimpleClo
    a TopLevelFlag
    NotTopLevel
          = Maybe (Id, OutExpr) -> OutExpr -> OutExpr
    wrapLet Maybe (Id, OutExpr)
    mb_pr (OutExpr -> OutExpr) -> OutExpr -> OutExpr
    forall a b. (a -> b) -> a -> b
    $ SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    do_beta SimpleOptEnv
    env'' OutExpr
    body [SimpleClo]
    as

          where (SimpleOptEnv
    env', Id
    b') = SimpleOptEnv -> Id -> (SimpleOptEnv, Id)
    subst_opt_bndr SimpleOptEnv
    env Id
    b

        do_beta SimpleOptEnv
    env OutExpr
    body [SimpleClo]
    as
          = HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app SimpleOptEnv
    env OutExpr
    body [SimpleClo]
    as

    simple_app SimpleOptEnv
    env (Tick CoreTickish
    t OutExpr
    e) [SimpleClo]
    as
      -- Okay to do "(Tick t e) x ==> Tick t (e x)"?
      | CoreTickish
    t CoreTickish -> TickishScoping -> Bool
    forall (pass :: TickishPass).
    GenTickish pass -> TickishScoping -> Bool
    `tickishScopesLike` TickishScoping
    SoftScope
      = CoreTickish -> OutExpr -> OutExpr
    mkTick CoreTickish
    t (OutExpr -> OutExpr) -> OutExpr -> OutExpr
    forall a b. (a -> b) -> a -> b
    $ HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app SimpleOptEnv
    env OutExpr
    e [SimpleClo]
    as

    -- (let x = e in b) a1 .. an  =>  let x = e in (b a1 .. an)
    -- The let might appear there as a result of inlining
    -- e.g.   let f = let x = e in b
    --        in f a1 a2
    --   (#13208)
    -- However, do /not/ do this transformation for join points
    --    See Note [simple_app and join points]
    simple_app SimpleOptEnv
    env (Let InBind
    bind OutExpr
    body) [SimpleClo]
    args
      = case SimpleOptEnv
    -> InBind -> TopLevelFlag -> (SimpleOptEnv, Maybe InBind)
    simple_opt_bind SimpleOptEnv
    env InBind
    bind TopLevelFlag
    NotTopLevel of
          (SimpleOptEnv
    env', Maybe InBind
    Nothing)   -> HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app SimpleOptEnv
    env' OutExpr
    body [SimpleClo]
    args
          (SimpleOptEnv
    env', Just InBind
    bind')
            | InBind -> Bool
    isJoinBind InBind
    bind' -> HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    finish_app SimpleOptEnv
    env OutExpr
    expr' [SimpleClo]
    args
            | Bool
    otherwise        -> InBind -> OutExpr -> OutExpr
    forall b. Bind b -> Expr b -> Expr b
    Let InBind
    bind' (HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app SimpleOptEnv
    env' OutExpr
    body [SimpleClo]
    args)
            where
              expr' :: OutExpr
    expr' = InBind -> OutExpr -> OutExpr
    forall b. Bind b -> Expr b -> Expr b
    Let InBind
    bind' (HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env' OutExpr
    body)

    simple_app SimpleOptEnv
    env OutExpr
    e [SimpleClo]
    as
      = HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    finish_app SimpleOptEnv
    env (HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env OutExpr
    e) [SimpleClo]
    as

    finish_app :: HasDebugCallStack
               => SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    -- See Note [Eliminate casts in function position]
    finish_app :: HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    finish_app SimpleOptEnv
    env (Cast (Lam Id
    x OutExpr
    e) Coercion
    co) as :: [SimpleClo]
    as@(SimpleClo
    _:[SimpleClo]
    _)
      | Bool -> Bool
    not (Id -> Bool
    isTyVar Id
    x) Bool -> Bool -> Bool
    && Bool -> Bool
    not (Id -> Bool
    isCoVar Id
    x)
      , Bool -> Bool -> Bool
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Id
    x Id -> VarSet -> Bool
    `elemVarSet` Coercion -> VarSet
    tyCoVarsOfCo Coercion
    co) Bool
    True
      , Just (Id
    x',OutExpr
    e') <- HasDebugCallStack =>
    InScopeSet -> Id -> OutExpr -> Coercion -> Maybe (Id, OutExpr)
    InScopeSet -> Id -> OutExpr -> Coercion -> Maybe (Id, OutExpr)
    pushCoercionIntoLambda (SimpleOptEnv -> InScopeSet
    soeInScope SimpleOptEnv
    env) Id
    x OutExpr
    e Coercion
    co
      = HasDebugCallStack =>
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
    simple_app (SimpleOptEnv -> SimpleOptEnv
    soeZapSubst SimpleOptEnv
    env) (Id -> OutExpr -> OutExpr
    forall b. b -> Expr b -> Expr b
    Lam Id
    x' OutExpr
    e') [SimpleClo]
    as

    finish_app SimpleOptEnv
    env OutExpr
    fun [SimpleClo]
    args
      = (OutExpr -> SimpleClo -> OutExpr)
    -> OutExpr -> [SimpleClo] -> OutExpr
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl OutExpr -> SimpleClo -> OutExpr
    mk_app OutExpr
    fun [SimpleClo]
    args
      where
        in_scope :: InScopeSet
    in_scope = SimpleOptEnv -> InScopeSet
    soeInScope SimpleOptEnv
    env
        mk_app :: OutExpr -> SimpleClo -> OutExpr
    mk_app OutExpr
    fun SimpleClo
    arg = OutExpr -> OutExpr -> OutExpr
    forall b. Expr b -> Expr b -> Expr b
    App OutExpr
    fun (HasDebugCallStack => InScopeSet -> SimpleClo -> OutExpr
    InScopeSet -> SimpleClo -> OutExpr
    simple_opt_clo InScopeSet
    in_scope SimpleClo
    arg)

    ----------------------
    simple_opt_bind :: SimpleOptEnv -> InBind -> TopLevelFlag
                    -> (SimpleOptEnv, Maybe OutBind)
    simple_opt_bind :: SimpleOptEnv
    -> InBind -> TopLevelFlag -> (SimpleOptEnv, Maybe InBind)
    simple_opt_bind SimpleOptEnv
    env (NonRec Id
    b OutExpr
    r) TopLevelFlag
    top_level
      = (SimpleOptEnv
    env', case Maybe (Id, OutExpr)
    mb_pr of
                Maybe (Id, OutExpr)
    Nothing    -> Maybe InBind
    forall a. Maybe a
    Nothing
                Just (Id
    b,OutExpr
    r) -> InBind -> Maybe InBind
    forall a. a -> Maybe a
    Just (Id -> OutExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec Id
    b OutExpr
    r))
      where
        (Id
    b', OutExpr
    r') = Id -> OutExpr -> Maybe (Id, OutExpr)
    joinPointBinding_maybe Id
    b OutExpr
    r Maybe (Id, OutExpr) -> (Id, OutExpr) -> (Id, OutExpr)
    forall a. Maybe a -> a -> a
    `orElse` (Id
    b, OutExpr
    r)
        (SimpleOptEnv
    env', Maybe (Id, OutExpr)
    mb_pr) = SimpleOptEnv
    -> Id
    -> Maybe Id
    -> SimpleClo
    -> TopLevelFlag
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_bind_pair SimpleOptEnv
    env Id
    b' Maybe Id
    forall a. Maybe a
    Nothing (SimpleOptEnv
    env,OutExpr
    r') TopLevelFlag
    top_level

    simple_opt_bind SimpleOptEnv
    env (Rec [(Id, OutExpr)]
    prs) TopLevelFlag
    top_level
      = (SimpleOptEnv
    env2, Maybe InBind
    res_bind)
      where
        res_bind :: Maybe InBind
    res_bind          = InBind -> Maybe InBind
    forall a. a -> Maybe a
    Just ([(Id, OutExpr)] -> InBind
    forall b. [(b, Expr b)] -> Bind b
    Rec ([(Id, OutExpr)] -> [(Id, OutExpr)]
    forall a. [a] -> [a]
    reverse [(Id, OutExpr)]
    rev_prs'))
        prs' :: [(Id, OutExpr)]
    prs'              = [(Id, OutExpr)] -> Maybe [(Id, OutExpr)]
    joinPointBindings_maybe [(Id, OutExpr)]
    prs Maybe [(Id, OutExpr)] -> [(Id, OutExpr)] -> [(Id, OutExpr)]
    forall a. Maybe a -> a -> a
    `orElse` [(Id, OutExpr)]
    prs
        (SimpleOptEnv
    env1, [Id]
    bndrs')    = SimpleOptEnv -> [Id] -> (SimpleOptEnv, [Id])
    subst_opt_bndrs SimpleOptEnv
    env (((Id, OutExpr) -> Id) -> [(Id, OutExpr)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id, OutExpr) -> Id
    forall a b. (a, b) -> a
    fst [(Id, OutExpr)]
    prs')
        (SimpleOptEnv
    env2, [(Id, OutExpr)]
    rev_prs')  = SimpleOptEnv
    -> [Id]
    -> (SimpleOptEnv -> (SimpleOptEnv, [(Id, OutExpr)]))
    -> (SimpleOptEnv, [(Id, OutExpr)])
    forall r.
    SimpleOptEnv
    -> [Id] -> (SimpleOptEnv -> (SimpleOptEnv, r)) -> (SimpleOptEnv, r)
    enterRecGroupRHSs SimpleOptEnv
    env1 [Id]
    bndrs' ((SimpleOptEnv -> (SimpleOptEnv, [(Id, OutExpr)]))
     -> (SimpleOptEnv, [(Id, OutExpr)]))
    -> (SimpleOptEnv -> (SimpleOptEnv, [(Id, OutExpr)]))
    -> (SimpleOptEnv, [(Id, OutExpr)])
    forall a b. (a -> b) -> a -> b
    $ \SimpleOptEnv
    env ->
                              ((SimpleOptEnv, [(Id, OutExpr)])
     -> ((Id, OutExpr), Id) -> (SimpleOptEnv, [(Id, OutExpr)]))
    -> (SimpleOptEnv, [(Id, OutExpr)])
    -> [((Id, OutExpr), Id)]
    -> (SimpleOptEnv, [(Id, OutExpr)])
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (SimpleOptEnv, [(Id, OutExpr)])
    -> ((Id, OutExpr), Id) -> (SimpleOptEnv, [(Id, OutExpr)])
    do_pr (SimpleOptEnv
    env, []) ([(Id, OutExpr)]
    prs' [(Id, OutExpr)] -> [Id] -> [((Id, OutExpr), Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Id]
    bndrs')
        do_pr :: (SimpleOptEnv, [(Id, OutExpr)])
    -> ((Id, OutExpr), Id) -> (SimpleOptEnv, [(Id, OutExpr)])
    do_pr (SimpleOptEnv
    env, [(Id, OutExpr)]
    prs) ((Id
    b,OutExpr
    r), Id
    b')
           = (SimpleOptEnv
    env', case Maybe (Id, OutExpr)
    mb_pr of
                      Just (Id, OutExpr)
    pr -> (Id, OutExpr)
    pr (Id, OutExpr) -> [(Id, OutExpr)] -> [(Id, OutExpr)]
    forall a. a -> [a] -> [a]
    : [(Id, OutExpr)]
    prs
                      Maybe (Id, OutExpr)
    Nothing -> [(Id, OutExpr)]
    prs)
           where
             (SimpleOptEnv
    env', Maybe (Id, OutExpr)
    mb_pr) = SimpleOptEnv
    -> Id
    -> Maybe Id
    -> SimpleClo
    -> TopLevelFlag
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_bind_pair SimpleOptEnv
    env Id
    b (Id -> Maybe Id
    forall a. a -> Maybe a
    Just Id
    b') (SimpleOptEnv
    env,OutExpr
    r) TopLevelFlag
    top_level

    ----------------------
    simple_bind_pair :: SimpleOptEnv
                     -> InVar -> Maybe OutVar
                     -> SimpleClo
                     -> TopLevelFlag
                     -> (SimpleOptEnv, Maybe (OutVar, OutExpr))
        -- (simple_bind_pair subst in_var out_rhs)
        --   either extends subst with (in_var -> out_rhs)
        --   or     returns Nothing
    simple_bind_pair :: SimpleOptEnv
    -> Id
    -> Maybe Id
    -> SimpleClo
    -> TopLevelFlag
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_bind_pair env :: SimpleOptEnv
    env@(SOE { soe_inl :: SimpleOptEnv -> IdEnv SimpleClo
    soe_inl = IdEnv SimpleClo
    inl_env, soe_subst :: SimpleOptEnv -> Subst
    soe_subst = Subst
    subst })
                     Id
    in_bndr Maybe Id
    mb_out_bndr clo :: SimpleClo
    clo@(SimpleOptEnv
    rhs_env, OutExpr
    in_rhs)
                     TopLevelFlag
    top_level
      | Type Type
    ty <- OutExpr
    in_rhs        -- let a::* = TYPE ty in <body>
      , let out_ty :: Type
    out_ty = Subst -> Type -> Type
    substTyUnchecked (SimpleOptEnv -> Subst
    soe_subst SimpleOptEnv
    rhs_env) Type
    ty
      = Bool
    -> SDoc
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Id -> Bool
    isTyVar Id
    in_bndr) (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    in_bndr SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ OutExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutExpr
    in_rhs) ((SimpleOptEnv, Maybe (Id, OutExpr))
     -> (SimpleOptEnv, Maybe (Id, OutExpr)))
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    forall a b. (a -> b) -> a -> b
    $
        (SimpleOptEnv
    env { soe_subst = extendTvSubst subst in_bndr out_ty }, Maybe (Id, OutExpr)
    forall a. Maybe a
    Nothing)

      | Coercion Coercion
    co <- OutExpr
    in_rhs
      , let out_co :: Coercion
    out_co = OptCoercionOpts -> Subst -> Coercion -> Coercion
    optCoercion (SimpleOpts -> OptCoercionOpts
    so_co_opts (SimpleOptEnv -> SimpleOpts
    soe_opts SimpleOptEnv
    env)) (SimpleOptEnv -> Subst
    soe_subst SimpleOptEnv
    rhs_env) Coercion
    co
      = Bool
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    forall a. HasCallStack => Bool -> a -> a
    assert (Id -> Bool
    isCoVar Id
    in_bndr)
        (SimpleOptEnv
    env { soe_subst = extendCvSubst subst in_bndr out_co }, Maybe (Id, OutExpr)
    forall a. Maybe a
    Nothing)

      | Bool -> SDoc -> Bool -> Bool
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Id -> Bool
    isNonCoVarId Id
    in_bndr) (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    in_bndr)
        -- The previous two guards got rid of tyvars and coercions
        -- See Note [Core type and coercion invariant] in GHC.Core
        Bool
    pre_inline_unconditionally
      = (SimpleOptEnv
    env { soe_inl = extendVarEnv inl_env in_bndr clo }, Maybe (Id, OutExpr)
    forall a. Maybe a
    Nothing)

      | Bool
    otherwise
      = SimpleOptEnv
    -> Id
    -> Maybe Id
    -> OutExpr
    -> OccInfo
    -> Bool
    -> Bool
    -> TopLevelFlag
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_out_bind_pair SimpleOptEnv
    env Id
    in_bndr Maybe Id
    mb_out_bndr OutExpr
    out_rhs
                             OccInfo
    occ Bool
    active Bool
    stable_unf TopLevelFlag
    top_level
      where
        stable_unf :: Bool
    stable_unf = Unfolding -> Bool
    isStableUnfolding (IdUnfoldingFun
    idUnfolding Id
    in_bndr)
        active :: Bool
    active     = Activation -> Bool
    isAlwaysActive (Id -> Activation
    idInlineActivation Id
    in_bndr)
        occ :: OccInfo
    occ        = Id -> OccInfo
    idOccInfo Id
    in_bndr
        in_scope :: InScopeSet
    in_scope   = Subst -> InScopeSet
    getSubstInScope Subst
    subst

        out_rhs :: OutExpr
    out_rhs | JoinPoint BranchCount
    join_arity <- Id -> JoinPointHood
    idJoinPointHood Id
    in_bndr
                = BranchCount -> OutExpr
    simple_join_rhs BranchCount
    join_arity
                | Bool
    otherwise
                = HasDebugCallStack => InScopeSet -> SimpleClo -> OutExpr
    InScopeSet -> SimpleClo -> OutExpr
    simple_opt_clo InScopeSet
    in_scope SimpleClo
    clo

        simple_join_rhs :: BranchCount -> OutExpr
    simple_join_rhs BranchCount
    join_arity -- See Note [Preserve join-binding arity]
          = [Id] -> OutExpr -> OutExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [Id]
    join_bndrs' (HasDebugCallStack => SimpleOptEnv -> OutExpr -> OutExpr
    SimpleOptEnv -> OutExpr -> OutExpr
    simple_opt_expr SimpleOptEnv
    env_body OutExpr
    join_body)
          where
            env0 :: SimpleOptEnv
    env0 = InScopeSet -> SimpleOptEnv -> SimpleOptEnv
    soeSetInScope InScopeSet
    in_scope SimpleOptEnv
    rhs_env
            ([Id]
    join_bndrs, OutExpr
    join_body) = BranchCount -> OutExpr -> ([Id], OutExpr)
    forall b. BranchCount -> Expr b -> ([b], Expr b)
    collectNBinders BranchCount
    join_arity OutExpr
    in_rhs
            (SimpleOptEnv
    env_body, [Id]
    join_bndrs') = SimpleOptEnv -> [Id] -> (SimpleOptEnv, [Id])
    subst_opt_bndrs SimpleOptEnv
    env0 [Id]
    join_bndrs

        pre_inline_unconditionally :: Bool
        pre_inline_unconditionally :: Bool
    pre_inline_unconditionally
           | Id -> Bool
    isExportedId Id
    in_bndr     = Bool
    False
           | Bool
    stable_unf               = Bool
    False
           | Bool -> Bool
    not Bool
    active               = Bool
    False    -- Note [Inline prag in simplOpt]
           | Bool -> Bool
    not (OccInfo -> Bool
    safe_to_inline OccInfo
    occ) = Bool
    False
           | Bool
    otherwise                = Bool
    True

            -- Unconditionally safe to inline
    safe_to_inline :: OccInfo -> Bool
    safe_to_inline :: OccInfo -> Bool
    safe_to_inline IAmALoopBreaker{}                  = Bool
    False
    safe_to_inline OccInfo
    IAmDead                            = Bool
    True
    safe_to_inline OneOcc{ occ_in_lam :: OccInfo -> InsideLam
    occ_in_lam = InsideLam
    NotInsideLam
                         , occ_n_br :: OccInfo -> BranchCount
    occ_n_br = BranchCount
    1 }             = Bool
    True
    safe_to_inline OneOcc{}                           = Bool
    False
    safe_to_inline ManyOccs{}                         = Bool
    False

    do_beta_by_substitution :: Id -> CoreExpr -> Bool
    -- True <=> you can inline (bndr = rhs) by substitution
    -- See Note [Exploit occ-info in exprIsConApp_maybe]
    do_beta_by_substitution :: Id -> OutExpr -> Bool
    do_beta_by_substitution Id
    bndr OutExpr
    rhs
      = OutExpr -> Bool
    exprIsTrivial OutExpr
    rhs                   -- Can duplicate
        Bool -> Bool -> Bool
    || OccInfo -> Bool
    safe_to_inline (Id -> OccInfo
    idOccInfo Id
    bndr)  -- Occurs at most once

    do_case_elim :: CoreExpr -> Id -> [Id] -> Bool
    do_case_elim :: OutExpr -> Id -> [Id] -> Bool
    do_case_elim OutExpr
    scrut Id
    case_bndr [Id]
    alt_bndrs
      =  OutExpr -> Bool
    exprIsHNF OutExpr
    scrut
      Bool -> Bool -> Bool
    && OccInfo -> Bool
    safe_to_inline (Id -> OccInfo
    idOccInfo Id
    case_bndr)
      Bool -> Bool -> Bool
    && (Id -> Bool) -> [Id] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Id -> Bool
    isDeadBinder [Id]
    alt_bndrs

    -------------------
    simple_out_bind :: TopLevelFlag
                    -> SimpleOptEnv
                    -> (InVar, OutExpr)
                    -> (SimpleOptEnv, Maybe (OutVar, OutExpr))
    simple_out_bind :: TopLevelFlag
    -> SimpleOptEnv
    -> (Id, OutExpr)
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_out_bind TopLevelFlag
    top_level env :: SimpleOptEnv
    env@(SOE { soe_subst :: SimpleOptEnv -> Subst
    soe_subst = Subst
    subst }) (Id
    in_bndr, OutExpr
    out_rhs)
      | Type Type
    out_ty <- OutExpr
    out_rhs
      = Bool
    -> SDoc
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Id -> Bool
    isTyVar Id
    in_bndr) (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    in_bndr SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    out_ty SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ OutExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OutExpr
    out_rhs)
        (SimpleOptEnv
    env { soe_subst = extendTvSubst subst in_bndr out_ty }, Maybe (Id, OutExpr)
    forall a. Maybe a
    Nothing)

      | Coercion Coercion
    out_co <- OutExpr
    out_rhs
      = Bool
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    forall a. HasCallStack => Bool -> a -> a
    assert (Id -> Bool
    isCoVar Id
    in_bndr)
        (SimpleOptEnv
    env { soe_subst = extendCvSubst subst in_bndr out_co }, Maybe (Id, OutExpr)
    forall a. Maybe a
    Nothing)

      | Bool
    otherwise
      = SimpleOptEnv
    -> Id
    -> Maybe Id
    -> OutExpr
    -> OccInfo
    -> Bool
    -> Bool
    -> TopLevelFlag
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_out_bind_pair SimpleOptEnv
    env Id
    in_bndr Maybe Id
    forall a. Maybe a
    Nothing OutExpr
    out_rhs
                             (Id -> OccInfo
    idOccInfo Id
    in_bndr) Bool
    True Bool
    False TopLevelFlag
    top_level

    -------------------
    simple_out_bind_pair :: SimpleOptEnv
                         -> InId -> Maybe OutId -> OutExpr
                         -> OccInfo -> Bool -> Bool -> TopLevelFlag
                         -> (SimpleOptEnv, Maybe (OutVar, OutExpr))
    simple_out_bind_pair :: SimpleOptEnv
    -> Id
    -> Maybe Id
    -> OutExpr
    -> OccInfo
    -> Bool
    -> Bool
    -> TopLevelFlag
    -> (SimpleOptEnv, Maybe (Id, OutExpr))
    simple_out_bind_pair SimpleOptEnv
    env Id
    in_bndr Maybe Id
    mb_out_bndr OutExpr
    out_rhs
                         OccInfo
    occ_info Bool
    active Bool
    stable_unf TopLevelFlag
    top_level
      | Bool -> SDoc -> Bool -> Bool
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Id -> Bool
    isNonCoVarId Id
    in_bndr) (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    in_bndr)
        -- Type and coercion bindings are caught earlier
        -- See Note [Core type and coercion invariant]
        Bool
    post_inline_unconditionally
      = ( SimpleOptEnv
    env' { soe_subst = extendIdSubst (soe_subst env) in_bndr out_rhs }
        , Maybe (Id, OutExpr)
    forall a. Maybe a
    Nothing)

      | Bool
    otherwise
      = ( SimpleOptEnv
    env', (Id, OutExpr) -> Maybe (Id, OutExpr)
    forall a. a -> Maybe a
    Just (Id
    out_bndr, OutExpr
    out_rhs) )
      where
        (SimpleOptEnv
    env', Id
    bndr1) = case Maybe Id
    mb_out_bndr of
                          Just Id
    out_bndr -> (SimpleOptEnv
    env, Id
    out_bndr)
                          Maybe Id
    Nothing       -> SimpleOptEnv -> Id -> (SimpleOptEnv, Id)
    subst_opt_bndr SimpleOptEnv
    env Id
    in_bndr
        out_bndr :: Id
    out_bndr = SimpleOptEnv -> Id -> TopLevelFlag -> OutExpr -> Id -> Id
    add_info SimpleOptEnv
    env' Id
    in_bndr TopLevelFlag
    top_level OutExpr
    out_rhs Id
    bndr1

        post_inline_unconditionally :: Bool
        post_inline_unconditionally :: Bool
    post_inline_unconditionally
           | Id -> Bool
    isExportedId Id
    in_bndr  = Bool
    False -- Note [Exported Ids and trivial RHSs]
           | Bool
    stable_unf            = Bool
    False -- Note [Stable unfoldings and postInlineUnconditionally]
           | Bool -> Bool
    not Bool
    active            = Bool
    False --     in GHC.Core.Opt.Simplify.Utils
           | Bool
    is_loop_breaker       = Bool
    False -- If it's a loop-breaker of any kind, don't inline
                                           -- because it might be referred to "earlier"
           | OutExpr -> Bool
    exprIsTrivial OutExpr
    out_rhs = Bool
    True
           | Bool
    coercible_hack        = Bool
    True
           | Bool
    otherwise             = Bool
    False

        is_loop_breaker :: Bool
    is_loop_breaker = OccInfo -> Bool
    isWeakLoopBreaker OccInfo
    occ_info

        -- See Note [Getting the map/coerce RULE to work]
        coercible_hack :: Bool
    coercible_hack | (Var Id
    fun, [OutExpr]
    args) <- OutExpr -> (OutExpr, [OutExpr])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs OutExpr
    out_rhs
                       , Just DataCon
    dc <- Id -> Maybe DataCon
    isDataConWorkId_maybe Id
    fun
                       , DataCon
    dc DataCon -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    heqDataConKey Bool -> Bool -> Bool
    || DataCon
    dc DataCon -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    coercibleDataConKey
                       = (OutExpr -> Bool) -> [OutExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all OutExpr -> Bool
    exprIsTrivial [OutExpr]
    args
                       | Bool
    otherwise
                       = Bool
    False

    {- Note [Exported Ids and trivial RHSs]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We obviously do not want to unconditionally inline an Id that is exported.
    In GHC.Core.Opt.Simplify.Utils, Note [Top level and postInlineUnconditionally], we
    explain why we don't inline /any/ top-level things unconditionally, even
    trivial ones.  But we do here!  Why?  In the simple optimiser

      * We do no rule rewrites
      * We do no call-site inlining

    Those differences obviate the reasons for not inlining a trivial rhs,
    and increase the benefit for doing so.  So we unconditionally inline trivial
    rhss here.

    Note [Eliminate casts in function position]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider the following program:

      type R :: Type -> RuntimeRep
      type family R a where { R Float = FloatRep; R Double = DoubleRep }
      type F :: forall (a :: Type) -> TYPE (R a)
      type family F a where { F Float = Float#  ; F Double = Double# }

      type N :: forall (a :: Type) -> TYPE (R a)
      newtype N a = MkN (F a)

    As MkN is a newtype, its unfolding is a lambda which wraps its argument
    in a cast:

      MkN :: forall (a :: Type). F a -> N a
      MkN = /\a \(x::F a). x |> co_ax
        -- recall that F a :: TYPE (R a)

    This is a representation-polymorphic lambda, in which the binder has an unknown
    representation (R a). We can't compile such a lambda on its own, but we can
    compile instantiations, such as `MkN @Float` or `MkN @Double`.

    Our strategy to avoid running afoul of the representation-polymorphism
    invariants of Note [Representation polymorphism invariants] in GHC.Core is thus:

      1. Give the newtype a compulsory unfolding (it has no binding, as we can't
         define lambdas with representation-polymorphic value binders in source Haskell).
      2. Rely on the optimiser to beta-reduce away any representation-polymorphic
         value binders.

    For example, consider the application

        MkN @Float 34.0#

    After inlining MkN we'll get

       ((/\a \(x:F a). x |> co_ax) @Float) |> co 34#

    where co :: (F Float -> N Float) ~ (Float# ~ N Float)

    But to actually beta-reduce that lambda, we need to push the 'co'
    inside the `\x` with pushCoecionIntoLambda.  Hence the extra
    equation for Cast-of-Lam in finish_app.

    This is regrettably delicate.

    Note [Preserve join-binding arity]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Be careful /not/ to eta-reduce the RHS of a join point, lest we lose
    the join-point arity invariant.  #15108 was caused by simplifying
    the RHS with simple_opt_expr, which does eta-reduction.  Solution:
    simplify the RHS of a join point by simplifying under the lambdas
    (which of course should be there).

    Note [simple_app and join points]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In general for let-bindings we can do this:
       (let { x = e } in b) a  ==>  let { x = e } in b a

    But not for join points!  For two reasons:

    - We would need to push the continuation into the RHS:
       (join { j = e } in b) a  ==>  let { j' = e a } in b[j'/j] a
                                          NB ----^^
      and also change the type of j, hence j'.
      That's a bit sophisticated for the very simple optimiser.

    - We might end up with something like
        join { j' = e a } in
        (case blah of        )
        (  True  -> j' void# ) a
        (  False -> blah     )
      and now the call to j' doesn't look like a tail call, and
      Lint may reject.  I say "may" because this is /explicitly/
      allowed in the "Compiling without Continuations" paper
      (Section 3, "Managing \Delta").  But GHC currently does not
      allow this slightly-more-flexible form.  See GHC.Core
      Note [Join points are less general than the paper].

    The simple thing to do is to disable this transformation
    for join points in the simple optimiser

    Note [The Let-Unfoldings Invariant]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    A program has the Let-Unfoldings property iff:

    - For every let-bound variable f, whether top-level or nested, whether
      recursive or not:
      - Both the binding Id of f, and every occurrence Id of f, has an idUnfolding.
      - For non-INLINE things, that unfolding will be f's right hand sids
      - For INLINE things (which have a "stable" unfolding) that unfolding is
        semantically equivalent to f's RHS, but derived from the original RHS of f
        rather that its current RHS.

    Informally, we can say that in a program that has the Let-Unfoldings property,
    all let-bound Id's have an explicit unfolding attached to them.

    Currently, the simplifier guarantees the Let-Unfoldings invariant for anything
    it outputs.

    -}

    ----------------------
    subst_opt_bndrs :: SimpleOptEnv -> [InVar] -> (SimpleOptEnv, [OutVar])
    subst_opt_bndrs :: SimpleOptEnv -> [Id] -> (SimpleOptEnv, [Id])
    subst_opt_bndrs SimpleOptEnv
    env [Id]
    bndrs = (SimpleOptEnv -> Id -> (SimpleOptEnv, Id))
    -> SimpleOptEnv -> [Id] -> (SimpleOptEnv, [Id])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL SimpleOptEnv -> Id -> (SimpleOptEnv, Id)
    subst_opt_bndr SimpleOptEnv
    env [Id]
    bndrs

    subst_opt_bndr :: SimpleOptEnv -> InVar -> (SimpleOptEnv, OutVar)
    subst_opt_bndr :: SimpleOptEnv -> Id -> (SimpleOptEnv, Id)
    subst_opt_bndr SimpleOptEnv
    env Id
    bndr
      | Id -> Bool
    isTyVar Id
    bndr  = (SimpleOptEnv
    env { soe_subst = subst_tv }, Id
    tv')
      | Id -> Bool
    isCoVar Id
    bndr  = (SimpleOptEnv
    env { soe_subst = subst_cv }, Id
    cv')
      | Bool
    otherwise     = SimpleOptEnv -> Id -> (SimpleOptEnv, Id)
    subst_opt_id_bndr SimpleOptEnv
    env Id
    bndr
      where
        subst :: Subst
    subst           = SimpleOptEnv -> Subst
    soe_subst SimpleOptEnv
    env
        (Subst
    subst_tv, Id
    tv') = HasDebugCallStack => Subst -> Id -> (Subst, Id)
    Subst -> Id -> (Subst, Id)
    substTyVarBndr Subst
    subst Id
    bndr
        (Subst
    subst_cv, Id
    cv') = HasDebugCallStack => Subst -> Id -> (Subst, Id)
    Subst -> Id -> (Subst, Id)
    substCoVarBndr Subst
    subst Id
    bndr

    subst_opt_id_bndr :: SimpleOptEnv -> InId -> (SimpleOptEnv, OutId)
    -- Nuke all fragile IdInfo, unfolding, and RULES; it gets added back later by
    -- add_info.
    --
    -- Rather like SimplEnv.substIdBndr
    --
    -- It's important to zap fragile OccInfo (which GHC.Core.Subst.substIdBndr
    -- carefully does not do) because simplOptExpr invalidates it

    subst_opt_id_bndr :: SimpleOptEnv -> Id -> (SimpleOptEnv, Id)
    subst_opt_id_bndr env :: SimpleOptEnv
    env@(SOE { soe_subst :: SimpleOptEnv -> Subst
    soe_subst = Subst
    subst, soe_inl :: SimpleOptEnv -> IdEnv SimpleClo
    soe_inl = IdEnv SimpleClo
    inl }) Id
    old_id
      = (SimpleOptEnv
    env { soe_subst = new_subst, soe_inl = new_inl }, Id
    new_id)
      where
        Subst InScopeSet
    in_scope IdSubstEnv
    id_subst TvSubstEnv
    tv_subst CvSubstEnv
    cv_subst = Subst
    subst

        id1 :: Id
    id1    = InScopeSet -> Id -> Id
    uniqAway InScopeSet
    in_scope Id
    old_id
        id2 :: Id
    id2    = (Type -> Type) -> Id -> Id
    updateIdTypeAndMult (Subst -> Type -> Type
    substTyUnchecked Subst
    subst) Id
    id1
        new_id :: Id
    new_id = Id -> Id
    zapFragileIdInfo Id
    id2
                 -- Zaps rules, unfolding, and fragile OccInfo
                 -- The unfolding and rules will get added back later, by add_info

        new_in_scope :: InScopeSet
    new_in_scope = InScopeSet
    in_scope InScopeSet -> Id -> InScopeSet
    `extendInScopeSet` Id
    new_id

        no_change :: Bool
    no_change = Id
    new_id Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    old_id

            -- Extend the substitution if the unique has changed,
            -- See the notes with substTyVarBndr for the delSubstEnv
        new_id_subst :: IdSubstEnv
    new_id_subst
          | Bool
    no_change = IdSubstEnv -> Id -> IdSubstEnv
    forall a. VarEnv a -> Id -> VarEnv a
    delVarEnv IdSubstEnv
    id_subst Id
    old_id
          | Bool
    otherwise = IdSubstEnv -> Id -> OutExpr -> IdSubstEnv
    forall a. VarEnv a -> Id -> a -> VarEnv a
    extendVarEnv IdSubstEnv
    id_subst Id
    old_id (Id -> OutExpr
    forall b. Id -> Expr b
    Var Id
    new_id)

        new_subst :: Subst
    new_subst = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
    Subst InScopeSet
    new_in_scope IdSubstEnv
    new_id_subst TvSubstEnv
    tv_subst CvSubstEnv
    cv_subst
        new_inl :: IdEnv SimpleClo
    new_inl   = IdEnv SimpleClo -> Id -> IdEnv SimpleClo
    forall a. VarEnv a -> Id -> VarEnv a
    delVarEnv IdEnv SimpleClo
    inl Id
    old_id

    ----------------------
    add_info :: SimpleOptEnv -> InVar -> TopLevelFlag -> OutExpr -> OutVar -> OutVar
    add_info :: SimpleOptEnv -> Id -> TopLevelFlag -> OutExpr -> Id -> Id
    add_info SimpleOptEnv
    env Id
    old_bndr TopLevelFlag
    top_level OutExpr
    new_rhs Id
    new_bndr
     | Id -> Bool
    isTyVar Id
    old_bndr = Id
    new_bndr
     | Bool
    otherwise        = Id -> IdInfo -> Id
    lazySetIdInfo Id
    new_bndr IdInfo
    new_info
     where
       subst :: Subst
    subst    = SimpleOptEnv -> Subst
    soe_subst SimpleOptEnv
    env
       uf_opts :: UnfoldingOpts
    uf_opts  = SimpleOpts -> UnfoldingOpts
    so_uf_opts (SimpleOptEnv -> SimpleOpts
    soe_opts SimpleOptEnv
    env)
       old_info :: IdInfo
    old_info = HasDebugCallStack => Id -> IdInfo
    Id -> IdInfo
    idInfo Id
    old_bndr

       -- Add back in the rules and unfolding which were
       -- removed by zapFragileIdInfo in subst_opt_id_bndr.
       --
       -- See Note [The Let-Unfoldings Invariant]
       new_info :: IdInfo
    new_info = HasDebugCallStack => Id -> IdInfo
    Id -> IdInfo
    idInfo Id
    new_bndr IdInfo -> RuleInfo -> IdInfo
    `setRuleInfo`      RuleInfo
    new_rules
                                  IdInfo -> Unfolding -> IdInfo
    `setUnfoldingInfo` Unfolding
    new_unfolding

       old_rules :: RuleInfo
    old_rules = IdInfo -> RuleInfo
    ruleInfo IdInfo
    old_info
       new_rules :: RuleInfo
    new_rules = Subst -> Id -> RuleInfo -> RuleInfo
    substRuleInfo Subst
    subst Id
    new_bndr RuleInfo
    old_rules

       old_unfolding :: Unfolding
    old_unfolding = IdInfo -> Unfolding
    realUnfoldingInfo IdInfo
    old_info
       new_unfolding :: Unfolding
    new_unfolding | Unfolding -> Bool
    isStableUnfolding Unfolding
    old_unfolding
                     = Subst -> Unfolding -> Unfolding
    substUnfolding Subst
    subst Unfolding
    old_unfolding
                     | Bool
    otherwise
                     = Unfolding
    unfolding_from_rhs

       unfolding_from_rhs :: Unfolding
    unfolding_from_rhs = UnfoldingOpts
    -> UnfoldingSource
    -> Bool
    -> Bool
    -> Bool
    -> OutExpr
    -> Maybe UnfoldingCache
    -> Unfolding
    mkUnfolding UnfoldingOpts
    uf_opts UnfoldingSource
    VanillaSrc
                                        (TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    top_level)
                                        Bool
    False -- may be bottom or not
                                        Bool
    False -- Not a join point
                                        OutExpr
    new_rhs Maybe UnfoldingCache
    forall a. Maybe a
    Nothing

    wrapLet :: Maybe (Id,CoreExpr) -> CoreExpr -> CoreExpr
    wrapLet :: Maybe (Id, OutExpr) -> OutExpr -> OutExpr
    wrapLet Maybe (Id, OutExpr)
    Nothing      OutExpr
    body = OutExpr
    body
    wrapLet (Just (Id
    b,OutExpr
    r)) OutExpr
    body = InBind -> OutExpr -> OutExpr
    forall b. Bind b -> Expr b -> Expr b
    Let (Id -> OutExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec Id
    b OutExpr
    r) OutExpr
    body

    {-
    Note [Inline prag in simplOpt]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If there's an INLINE/NOINLINE pragma that restricts the phase in
    which the binder can be inlined, we don't inline here; after all,
    we don't know what phase we're in.  Here's an example

      foo :: Int -> Int -> Int
      {-# INLINE foo #-}
      foo m n = inner m
         where
           {-# INLINE [1] inner #-}
           inner m = m+n

      bar :: Int -> Int
      bar n = foo n 1

    When inlining 'foo' in 'bar' we want the let-binding for 'inner'
    to remain visible until Phase 1

    Note [Unfold compulsory unfoldings in RULE LHSs]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When the user writes `RULES map coerce = coerce` as a rule, the rule
    will only ever match if simpleOptExpr replaces coerce by its unfolding
    on the LHS, because that is the core that the rule matching engine
    will find. So do that for everything that has a compulsory
    unfolding. Also see Note [Desugaring coerce as cast] in GHC.HsToCore.

    However, we don't want to inline 'seq', which happens to also have a
    compulsory unfolding, so we only do this unfolding only for things
    that are always-active.  See Note [User-defined RULES for seq] in GHC.Types.Id.Make.

    Note [Getting the map/coerce RULE to work]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We wish to allow the "map/coerce" RULE to fire:

      {-# RULES "map/coerce" map coerce = coerce #-}

    The naive core produced for this is

      forall a b (dict :: Coercible * a b).
        map @a @b (coerce @a @b @dict) = coerce @[a] @[b] @dict'

      where dict' :: Coercible [a] [b]
            dict' = ...

    This matches literal uses of `map coerce` in code, but that's not what we
    want. We want it to match, say, `map MkAge` (where newtype Age = MkAge Int)
    too.  Achieving all this is surprisingly tricky:

    (MC1) We must compulsorily unfold MkAge to a cast.
          See Note [Compulsory newtype unfolding] in GHC.Types.Id.Make

    (MC2) We must compulsorily unfolding coerce on the rule LHS, yielding
            forall a b (dict :: Coercible * a b).
              map @a @b (\(x :: a) -> case dict of
                MkCoercible (co :: a ~R# b) -> x |> co) = ...

      Getting better. But this isn't exactly what gets produced. This is because
      Coercible essentially has ~R# as a superclass, and superclasses get eagerly
      extracted during solving. So we get this:

        forall a b (dict :: Coercible * a b).
          case Coercible_SCSel @* @a @b dict of
            _ [Dead] -> map @a @b (\(x :: a) -> case dict of
                                     MkCoercible (co :: a ~R# b) -> x |> co) = ...

      Unfortunately, this still abstracts over a Coercible dictionary. We really
      want it to abstract over the ~R# evidence. So, we have Desugar.unfold_coerce,
      which transforms the above to
      Desugar)

        forall a b (co :: a ~R# b).
          let dict = MkCoercible @* @a @b co in
          case Coercible_SCSel @* @a @b dict of
            _ [Dead] -> map @a @b (\(x :: a) -> case dict of
               MkCoercible (co :: a ~R# b) -> x |> co) = let dict = ... in ...

      See Note [Desugaring coerce as cast] in GHC.HsToCore

    (MC3) Now, we need simpleOptExpr to fix this up. It does so by taking three
      separate actions:
      1. Inline certain non-recursive bindings. The choice whether to inline
         is made in simple_bind_pair. Note the rather specific check for
         MkCoercible in there.

      2. Stripping case expressions like the Coercible_SCSel one.
         See the `Case` case of simple_opt_expr's `go` function.

      3. Look for case expressions that unpack something that was
         just packed and inline them. This is also done in simple_opt_expr's
         `go` function.

    (MC4) The map/coerce rule is the only compelling reason for having a RULE that
      quantifies over a coercion variable, something that is otherwise Very Deeply
      Suspicous.  See Note [Casts in the template] in GHC.Core.Rules. Ugh!

    This is all a fair amount of special-purpose hackery, but it's for
    a good cause. And it won't hurt other RULES and such that it comes across.

    ************************************************************************
    *                                                                      *
                    Join points
    *                                                                      *
    ************************************************************************
    -}

    {- Note [Strictness and join points]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have

       let f = \x.  if x>200 then e1 else e1

    and we know that f is strict in x.  Then if we subsequently
    discover that f is an arity-2 join point, we'll eta-expand it to

       let f = \x y.  if x>200 then e1 else e1

    and now it's only strict if applied to two arguments.  So we should
    adjust the strictness info.

    A more common case is when

       f = \x. error ".."

    and again its arity increases (#15517)
    -}

    -- | Returns Just (bndr,rhs) if the binding is a join point:
    -- If it's a JoinId, just return it
    -- If it's not yet a JoinId but is always tail-called,
    --    make it into a JoinId and return it.
    -- In the latter case, eta-expand the RHS if necessary, to make the
    -- lambdas explicit, as is required for join points
    --
    -- Precondition: the InBndr has been occurrence-analysed,
    --               so its OccInfo is valid
    joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr)
    joinPointBinding_maybe :: Id -> OutExpr -> Maybe (Id, OutExpr)
    joinPointBinding_maybe Id
    bndr OutExpr
    rhs
      | Bool -> Bool
    not (Id -> Bool
    isId Id
    bndr)
      = Maybe (Id, OutExpr)
    forall a. Maybe a
    Nothing

      | Id -> Bool
    isJoinId Id
    bndr
      = (Id, OutExpr) -> Maybe (Id, OutExpr)
    forall a. a -> Maybe a
    Just (Id
    bndr, OutExpr
    rhs)

      | AlwaysTailCalled BranchCount
    join_arity <- OccInfo -> TailCallInfo
    tailCallInfo (Id -> OccInfo
    idOccInfo Id
    bndr)
      , ([Id]
    bndrs, OutExpr
    body) <- BranchCount -> OutExpr -> ([Id], OutExpr)
    etaExpandToJoinPoint BranchCount
    join_arity OutExpr
    rhs
      , let str_sig :: DmdSig
    str_sig   = Id -> DmdSig
    idDmdSig Id
    bndr
            str_arity :: BranchCount
    str_arity = (Id -> Bool) -> [Id] -> BranchCount
    forall a. (a -> Bool) -> [a] -> BranchCount
    count Id -> Bool
    isId [Id]
    bndrs  -- Strictness demands are for Ids only
            join_bndr :: Id
    join_bndr = Id
    bndr Id -> BranchCount -> Id
    `asJoinId`        BranchCount
    join_arity
                             Id -> DmdSig -> Id
    `setIdDmdSig` BranchCount -> DmdSig -> DmdSig
    etaConvertDmdSig BranchCount
    str_arity DmdSig
    str_sig
      = (Id, OutExpr) -> Maybe (Id, OutExpr)
    forall a. a -> Maybe a
    Just (Id
    join_bndr, [Id] -> OutExpr -> OutExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [Id]
    bndrs OutExpr
    body)

      | Bool
    otherwise
      = Maybe (Id, OutExpr)
    forall a. Maybe a
    Nothing

    joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)]
    joinPointBindings_maybe :: [(Id, OutExpr)] -> Maybe [(Id, OutExpr)]
    joinPointBindings_maybe [(Id, OutExpr)]
    bndrs
      = ((Id, OutExpr) -> Maybe (Id, OutExpr))
    -> [(Id, OutExpr)] -> Maybe [(Id, OutExpr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((Id -> OutExpr -> Maybe (Id, OutExpr))
    -> (Id, OutExpr) -> Maybe (Id, OutExpr)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Id -> OutExpr -> Maybe (Id, OutExpr)
    joinPointBinding_maybe) [(Id, OutExpr)]
    bndrs

    {- *********************************************************************
    *                                                                      *
             exprIsConApp_maybe
    *                                                                      *
    ************************************************************************

    Note [exprIsConApp_maybe]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    exprIsConApp_maybe is a very important function.  There are two principal
    uses:
      * case e of { .... }
      * cls_op e, where cls_op is a class operation

    In both cases you want to know if e is of form (C e1..en) where C is
    a data constructor.

    However e might not *look* as if

    Note [exprIsConApp_maybe on literal strings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    See #9400 and #13317.

    Conceptually, a string literal "abc" is just ('a':'b':'c':[]), but in Core
    they are represented as unpackCString# "abc"# by GHC.Core.Make.mkStringExprFS, or
    unpackCStringUtf8# when the literal contains multi-byte UTF8 characters.

    For optimizations we want to be able to treat it as a list, so they can be
    decomposed when used in a case-statement. exprIsConApp_maybe detects those
    calls to unpackCString# and returns:

    Just (':', [Char], ['a', unpackCString# "bc"]).

    We need to be careful about UTF8 strings here. ""# contains an encoded ByteString, so
    we call utf8UnconsByteString to correctly deal with the encoding and splitting.

    We must also be careful about
       lvl = "foo"#
       ...(unpackCString# lvl)...
    to ensure that we see through the let-binding for 'lvl'.  Hence the
    (exprIsLiteral_maybe .. arg) in the guard before the call to
    dealWithStringLiteral.

    The tests for this function are in T9400.

    Note [Push coercions in exprIsConApp_maybe]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In #13025 I found a case where we had
        op (df @t1 @t2)     -- op is a ClassOp
    where
        df = (/\a b. K e1 e2) |> g

    To get this to come out we need to simplify on the fly
       ((/\a b. K e1 e2) |> g) @t1 @t2

    Hence the use of pushCoArgs.

    Note [exprIsConApp_maybe on data constructors with wrappers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Problem:
    - some data constructors have wrappers
    - these wrappers inline late (see MkId Note [Activation for data constructor wrappers])
    - but we still want case-of-known-constructor to fire early.

    Example:
       data T = MkT !Int
       $WMkT n = case n of n' -> MkT n'   -- Wrapper for MkT
       foo x = case $WMkT e of MkT y -> blah

    Here we want the case-of-known-constructor transformation to fire, giving
       foo x = case e of x' -> let y = x' in blah

    Here's how exprIsConApp_maybe achieves this:

    0.  Start with scrutinee = $WMkT e

    1.  Inline $WMkT on-the-fly.  That's why data-constructor wrappers are marked
        as expandable. (See GHC.Core.Utils.isExpandableApp.) Now we have
          scrutinee = (\n. case n of n' -> MkT n') e

    2.  Beta-reduce the application, generating a floated 'let'.
        See Note [beta-reduction in exprIsConApp_maybe] below.  Now we have
          scrutinee = case n of n' -> MkT n'
          with floats {Let n = e}

    3.  Float the "case x of x' ->" binding out.  Now we have
          scrutinee = MkT n'
          with floats {Let n = e; case n of n' ->}

    And now we have a known-constructor MkT that we can return.

    Notice that both (2) and (3) require exprIsConApp_maybe to gather and return
    a bunch of floats, both let and case bindings.

    Note that this strategy introduces some subtle scenarios where a data-con
    wrapper can be replaced by a data-con worker earlier than we’d like, see
    Note [exprIsConApp_maybe for data-con wrappers: tricky corner].

    Note [beta-reduction in exprIsConApp_maybe]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The unfolding a definition (_e.g._ a let-bound variable or a datacon wrapper) is
    typically a function. For instance, take the wrapper for MkT in Note
    [exprIsConApp_maybe on data constructors with wrappers]:

        $WMkT n = case n of { n' -> T n' }

    If `exprIsConApp_maybe` is trying to analyse `$MkT arg`, upon unfolding of $MkT,
    it will see

       (\n -> case n of { n' -> T n' }) arg

    In order to go progress, `exprIsConApp_maybe` must perform a beta-reduction.

    We don't want to blindly substitute `arg` in the body of the function, because
    it duplicates work. We can (and, in fact, used to) substitute `arg` in the body,
    but only when `arg` is a variable (or something equally work-free).

    But, because of Note [exprIsConApp_maybe on data constructors with wrappers],
    'exprIsConApp_maybe' now returns floats. So, instead, we can beta-reduce
    _always_:

        (\x -> body) arg

    Is transformed into

       let x = arg in body

    Which, effectively, means emitting a float `let x = arg` and recursively
    analysing the body.

    For newtypes, this strategy requires that their wrappers have compulsory unfoldings.
    Suppose we have
       newtype T a b where
         MkT :: a -> T b a   -- Note args swapped

    This defines a worker function MkT, a wrapper function $WMkT, and an axT:
       $WMkT :: forall a b. a -> T b a
       $WMkT = /\b a. \(x:a). MkT a b x    -- A real binding

       MkT :: forall a b. a -> T a b
       MkT = /\a b. \(x:a). x |> (ax a b)  -- A compulsory unfolding

       axiom axT :: a ~R# T a b

    Now we are optimising
       case $WMkT (I# 3) |> sym axT of I# y -> ...
    we clearly want to simplify this. If $WMkT did not have a compulsory
    unfolding, we would end up with
       let a = I# 3 in case a of I# y -> ...
    because in general, we do this on-the-fly beta-reduction
       (\x. e) blah  -->  let x = blah in e
    and then float the let.  (Substitution would risk duplicating 'blah'.)

    But if the case-of-known-constructor doesn't actually fire (i.e.
    exprIsConApp_maybe does not return Just) then nothing happens, and nothing
    will happen the next time either.

    See test T16254, which checks the behavior of newtypes.

    Note [Exploit occ-info in exprIsConApp_maybe]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose (#23159) we have a simple data constructor wrapper like this (this one
    might have come from a data family instance):
       $WK x y = K x y |> co
    Now suppose the simplifier sees
       case ($WK e1 e2) |> co2 of
          K p q ->  case q of ...

    `exprIsConApp_maybe` expands the wrapper on the fly
    (see Note [beta-reduction in exprIsConApp_maybe]). It effectively expands
    that ($WK e1 e2) to
       let x = e1; y = e2 in K x y |> co

    So the Simplifier might end up producing this:
       let x = e1; y = e2
       in case x of ...

    But suppose `q` was used just once in the body of the `K p q` alternative; we
    don't want to wait a whole Simplifier iteration to inline that `x`.  (e1 might
    be another constructor for example.)  This would happen if `exprIsConApp_maybe`
    we created a let for every (non-trivial) argument.  So let's not do that when
    the binder is used just once!

    Instead, take advantage of the occurrence-info on `x` and `y` in the unfolding
    of `$WK`.  Since in `$WK` both `x` and `y` occur once, we want to effectively
    expand `($WK e1 e2)` to `(K e1 e2 |> co)`.  Hence in
    `do_beta_by_substitution` we say "yes" if

      (a) the RHS is trivial (so we can duplicate it);
          see call to `exprIsTrivial`
    or
      (b) the binder occurs at most once (so there is no worry about duplication);
          see call to `safe_to_inline`.

    To see this in action, look at testsuite/tests/perf/compiler/T15703.  The
    initial Simlifier run takes 5 iterations without (b), but only 3 when we add
    (b).

    Note [Don't float join points]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    exprIsConApp_maybe should succeed on
       let v = e in Just v
    returning [x=e] as one of the [FloatBind].  But it must
    NOT succeed on
       join j x = rhs in Just v
    because join-points can't be gaily floated.  Consider
       case (join j x = rhs in Just) of
         K p q -> blah
    We absolutely must not "simplify" this to
       join j x = rhs
       in blah
    because j's return type is (Maybe t), quite different to blah's.

    You might think this could never happen, because j can't be
    tail-called in the body if the body returns a constructor.  But
    in !3113 we had a /dead/ join point (which is not illegal),
    and its return type was wonky.

    The simple thing is not to float a join point.  The next iteration
    of the simplifier will sort everything out.  And it there is
    a join point, the chances are that the body is not a constructor
    application, so failing faster is good.

    Note [exprIsConApp_maybe for data-con wrappers: tricky corner]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Generally speaking

      * exprIsConApp_maybe honours the inline phase; that is, it does not look
        inside the unfolding for an Id unless its unfolding is active in this phase.
        That phase-sensitivity is expressed in the InScopeEnv (specifically, the
        IdUnfoldingFun component of the InScopeEnv) passed to exprIsConApp_maybe.

      * Data-constructor wrappers are active only in phase 0 (the last phase);
        see Note [Activation for data constructor wrappers] in GHC.Types.Id.Make.

    On the face of it that means that exprIsConApp_maybe won't look inside data
    constructor wrappers until phase 0. But that seems pretty Bad. So we cheat.
    For data con wrappers we unconditionally look inside its unfolding, regardless
    of phase, so that we get case-of-known-constructor to fire in every phase.

    Perhaps unsurprisingly, this cheating can backfire. An example:

        data T = C !A B
        foo p q = let x = C e1 e2 in seq x $ f x
        {-# RULE "wurble" f (C a b) = b #-}

    In Core, the RHS of foo is

        let x = $WC e1 e2 in case x of y { C _ _ -> f x }

    and after doing a binder swap and inlining x, we have:

        case $WC e1 e2 of y { C _ _ -> f y }

    Case-of-known-constructor fires, but now we have to reconstruct a binding for
    `y` (which was dead before the binder swap) on the RHS of the case alternative.
    Naturally, we’ll use the worker:

        case e1 of a { DEFAULT -> let y = C a e2 in f y }

    and after inlining `y`, we have:

        case e1 of a { DEFAULT -> f (C a e2) }

    Now we might hope the "wurble" rule would fire, but alas, it will not: we have
    replaced $WC with C, but the (desugared) rule matches on $WC! We weren’t
    supposed to inline $WC yet for precisely that reason (see Note [Activation for
    data constructor wrappers]), but our cheating in exprIsConApp_maybe came back to
    bite us.

    This is rather unfortunate, especially since this can happen inside stable
    unfoldings as well as ordinary code (which really happened, see !3041). But
    there is no obvious solution except to delay case-of-known-constructor on
    data-con wrappers, and that cure would be worse than the disease.

    This Note exists solely to document the problem.
    -}

    data ConCont = CC [CoreExpr] MCoercion
                      -- Substitution already applied

    -- | Returns @Just ([b1..bp], dc, [t1..tk], [x1..xn])@ if the argument
    -- expression is a *saturated* constructor application of the form @let b1 in
    -- .. let bp in dc t1..tk x1 .. xn@, where t1..tk are the
    -- *universally-quantified* type args of 'dc'. Floats can also be (and most
    -- likely are) single-alternative case expressions. Why does
    -- 'exprIsConApp_maybe' return floats? We may have to look through lets and
    -- cases to detect that we are in the presence of a data constructor wrapper. In
    -- this case, we need to return the lets and cases that we traversed. See Note
    -- [exprIsConApp_maybe on data constructors with wrappers]. Data constructor wrappers
    -- are unfolded late, but we really want to trigger case-of-known-constructor as
    -- early as possible. See also Note [Activation for data constructor wrappers]
    -- in "GHC.Types.Id.Make".
    --
    -- We also return the incoming InScopeSet, augmented with
    -- the binders from any [FloatBind] that we return
    exprIsConApp_maybe :: HasDebugCallStack
                       => InScopeEnv -> CoreExpr
                       -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
    exprIsConApp_maybe :: HasDebugCallStack =>
    InScopeEnv
    -> OutExpr
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    exprIsConApp_maybe ise :: InScopeEnv
    ise@(ISE InScopeSet
    in_scope IdUnfoldingFun
    id_unf) OutExpr
    expr
      = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go (InScopeSet -> Either InScopeSet Subst
    forall a b. a -> Either a b
    Left InScopeSet
    in_scope) [] OutExpr
    expr ([OutExpr] -> MCoercion -> ConCont
    CC [] MCoercion
    MRefl)
      where
        go :: Either InScopeSet Subst
                 -- Left in-scope  means "empty substitution"
                 -- Right subst    means "apply this substitution to the CoreExpr"
                 -- NB: in the call (go subst floats expr cont)
                 --     the substitution applies to 'expr', but /not/ to 'floats' or 'cont'
           -> [FloatBind] -> CoreExpr -> ConCont
                 -- Notice that the floats here are in reverse order
           -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
        go :: Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go Either InScopeSet Subst
    subst [FloatBind]
    floats (Tick CoreTickish
    t OutExpr
    expr) ConCont
    cont
           | Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishIsCode CoreTickish
    t) = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go Either InScopeSet Subst
    subst [FloatBind]
    floats OutExpr
    expr ConCont
    cont

        go Either InScopeSet Subst
    subst [FloatBind]
    floats (Cast OutExpr
    expr Coercion
    co1) (CC [OutExpr]
    args MCoercion
    m_co2)
           | Just ([OutExpr]
    args', MCoercion
    m_co1') <- Coercion -> [OutExpr] -> Maybe ([OutExpr], MCoercion)
    pushCoArgs (Either InScopeSet Subst -> Coercion -> Coercion
    forall {a}. Either a Subst -> Coercion -> Coercion
    subst_co Either InScopeSet Subst
    subst Coercion
    co1) [OutExpr]
    args
                -- See Note [Push coercions in exprIsConApp_maybe]
           = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go Either InScopeSet Subst
    subst [FloatBind]
    floats OutExpr
    expr ([OutExpr] -> MCoercion -> ConCont
    CC [OutExpr]
    args' (MCoercion
    m_co1' MCoercion -> MCoercion -> MCoercion
    `mkTransMCo` MCoercion
    m_co2))

        go Either InScopeSet Subst
    subst [FloatBind]
    floats (App OutExpr
    fun OutExpr
    arg) (CC [OutExpr]
    args MCoercion
    mco)
           | let arg_type :: Type
    arg_type = HasDebugCallStack => OutExpr -> Type
    OutExpr -> Type
    exprType OutExpr
    arg
           , Bool -> Bool
    not (OutExpr -> Bool
    forall b. Expr b -> Bool
    isTypeArg OutExpr
    arg) Bool -> Bool -> Bool
    && HasDebugCallStack => Type -> OutExpr -> Bool
    Type -> OutExpr -> Bool
    needsCaseBinding Type
    arg_type OutExpr
    arg
           -- An unlifted argument that’s not ok for speculation must not simply be
           -- put into the args, as these are going to be substituted into the case
           -- alternatives, and possibly lost on the way.
           --
           -- Instead, we need need to
           -- make sure they are evaluated right here (using a case float), and
           -- the case binder can then be substituted into the case alternaties.
           --
           -- Example:
           -- Simplifying  case Mk# exp of Mk# a → rhs
           -- will use     exprIsConApp_maybe (Mk# exp)
           --
           -- Bad:  returning (Mk#, [exp]) with no floats
           --       simplifier produces rhs[exp/a], changing semantics if exp is not ok-for-spec
           -- Good: returning (Mk#, [x]) with a float of  case exp of x { DEFAULT -> [] }
           --       simplifier produces case exp of a { DEFAULT -> exp[x/a] }
           = let arg' :: OutExpr
    arg' = Either InScopeSet Subst -> OutExpr -> OutExpr
    forall {a}. Either a Subst -> OutExpr -> OutExpr
    subst_expr Either InScopeSet Subst
    subst OutExpr
    arg
                 bndr :: Id
    bndr = InScopeSet -> Id -> Id
    uniqAway (Either InScopeSet Subst -> InScopeSet
    subst_in_scope Either InScopeSet Subst
    subst) (Type -> Type -> Id
    mkWildValBinder Type
    ManyTy Type
    arg_type)
                 float :: FloatBind
    float = OutExpr -> Id -> AltCon -> [Id] -> FloatBind
    FloatCase OutExpr
    arg' Id
    bndr AltCon
    DEFAULT []
                 subst' :: Either InScopeSet Subst
    subst' = Either InScopeSet Subst -> Id -> Either InScopeSet Subst
    subst_extend_in_scope Either InScopeSet Subst
    subst Id
    bndr
             in Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go Either InScopeSet Subst
    subst' (FloatBind
    floatFloatBind -> [FloatBind] -> [FloatBind]
    forall a. a -> [a] -> [a]
    :[FloatBind]
    floats) OutExpr
    fun ([OutExpr] -> MCoercion -> ConCont
    CC (Id -> OutExpr
    forall b. Id -> Expr b
    Var Id
    bndr OutExpr -> [OutExpr] -> [OutExpr]
    forall a. a -> [a] -> [a]
    : [OutExpr]
    args) MCoercion
    mco)
           | Bool
    otherwise
           = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go Either InScopeSet Subst
    subst [FloatBind]
    floats OutExpr
    fun ([OutExpr] -> MCoercion -> ConCont
    CC (Either InScopeSet Subst -> OutExpr -> OutExpr
    forall {a}. Either a Subst -> OutExpr -> OutExpr
    subst_expr Either InScopeSet Subst
    subst OutExpr
    arg OutExpr -> [OutExpr] -> [OutExpr]
    forall a. a -> [a] -> [a]
    : [OutExpr]
    args) MCoercion
    mco)

        go Either InScopeSet Subst
    subst [FloatBind]
    floats (Lam Id
    bndr OutExpr
    body) (CC (OutExpr
    arg:[OutExpr]
    args) MCoercion
    mco)
           | Id -> OutExpr -> Bool
    do_beta_by_substitution Id
    bndr OutExpr
    arg
           = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go (Either InScopeSet Subst -> Id -> OutExpr -> Either InScopeSet Subst
    forall {a}.
    Either InScopeSet Subst -> Id -> OutExpr -> Either a Subst
    extend Either InScopeSet Subst
    subst Id
    bndr OutExpr
    arg) [FloatBind]
    floats OutExpr
    body ([OutExpr] -> MCoercion -> ConCont
    CC [OutExpr]
    args MCoercion
    mco)
           | Bool
    otherwise
           = let (Either InScopeSet Subst
    subst', Id
    bndr') = Either InScopeSet Subst -> Id -> (Either InScopeSet Subst, Id)
    forall {a}. Either InScopeSet Subst -> Id -> (Either a Subst, Id)
    subst_bndr Either InScopeSet Subst
    subst Id
    bndr
                 float :: FloatBind
    float           = InBind -> FloatBind
    FloatLet (Id -> OutExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec Id
    bndr' OutExpr
    arg)
             in Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go Either InScopeSet Subst
    subst' (FloatBind
    floatFloatBind -> [FloatBind] -> [FloatBind]
    forall a. a -> [a] -> [a]
    :[FloatBind]
    floats) OutExpr
    body ([OutExpr] -> MCoercion -> ConCont
    CC [OutExpr]
    args MCoercion
    mco)

        go Either InScopeSet Subst
    subst [FloatBind]
    floats (Let (NonRec Id
    bndr OutExpr
    rhs) OutExpr
    expr) ConCont
    cont
           | Bool -> Bool
    not (Id -> Bool
    isJoinId Id
    bndr)
             -- Crucial guard! See Note [Don't float join points]
           = let rhs' :: OutExpr
    rhs'            = Either InScopeSet Subst -> OutExpr -> OutExpr
    forall {a}. Either a Subst -> OutExpr -> OutExpr
    subst_expr Either InScopeSet Subst
    subst OutExpr
    rhs
                 (Either InScopeSet Subst
    subst', Id
    bndr') = Either InScopeSet Subst -> Id -> (Either InScopeSet Subst, Id)
    forall {a}. Either InScopeSet Subst -> Id -> (Either a Subst, Id)
    subst_bndr Either InScopeSet Subst
    subst Id
    bndr
                 float :: FloatBind
    float           = InBind -> FloatBind
    FloatLet (Id -> OutExpr -> InBind
    forall b. b -> Expr b -> Bind b
    NonRec Id
    bndr' OutExpr
    rhs')
             in Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go Either InScopeSet Subst
    subst' (FloatBind
    floatFloatBind -> [FloatBind] -> [FloatBind]
    forall a. a -> [a] -> [a]
    :[FloatBind]
    floats) OutExpr
    expr ConCont
    cont

        go Either InScopeSet Subst
    subst [FloatBind]
    floats (Case OutExpr
    scrut Id
    b Type
    _ [Alt AltCon
    con [Id]
    vars OutExpr
    expr]) ConCont
    cont
           | OutExpr -> Id -> [Id] -> Bool
    do_case_elim OutExpr
    scrut' Id
    b [Id]
    vars  -- See Note [Case elim in exprIsConApp_maybe]
           = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go (Either InScopeSet Subst -> Id -> OutExpr -> Either InScopeSet Subst
    forall {a}.
    Either InScopeSet Subst -> Id -> OutExpr -> Either a Subst
    extend Either InScopeSet Subst
    subst Id
    b OutExpr
    scrut') [FloatBind]
    floats OutExpr
    expr ConCont
    cont
           | Bool
    otherwise
           = let
              (Either InScopeSet Subst
    subst', Id
    b')     = Either InScopeSet Subst -> Id -> (Either InScopeSet Subst, Id)
    forall {a}. Either InScopeSet Subst -> Id -> (Either a Subst, Id)
    subst_bndr Either InScopeSet Subst
    subst Id
    b
              (Either InScopeSet Subst
    subst'', [Id]
    vars') = Either InScopeSet Subst -> [Id] -> (Either InScopeSet Subst, [Id])
    forall {t :: * -> *}.
    Traversable t =>
    Either InScopeSet Subst -> t Id -> (Either InScopeSet Subst, t Id)
    subst_bndrs Either InScopeSet Subst
    subst' [Id]
    vars
              float :: FloatBind
    float            = OutExpr -> Id -> AltCon -> [Id] -> FloatBind
    FloatCase OutExpr
    scrut' Id
    b' AltCon
    con [Id]
    vars'
             in
               Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go Either InScopeSet Subst
    subst'' (FloatBind
    floatFloatBind -> [FloatBind] -> [FloatBind]
    forall a. a -> [a] -> [a]
    :[FloatBind]
    floats) OutExpr
    expr ConCont
    cont
           where
              scrut' :: OutExpr
    scrut'           = Either InScopeSet Subst -> OutExpr -> OutExpr
    forall {a}. Either a Subst -> OutExpr -> OutExpr
    subst_expr Either InScopeSet Subst
    subst OutExpr
    scrut

        go (Right Subst
    sub) [FloatBind]
    floats (Var Id
    v) ConCont
    cont
           = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go (InScopeSet -> Either InScopeSet Subst
    forall a b. a -> Either a b
    Left (Subst -> InScopeSet
    getSubstInScope Subst
    sub))
                [FloatBind]
    floats
                (HasDebugCallStack => Subst -> Id -> OutExpr
    Subst -> Id -> OutExpr
    lookupIdSubst Subst
    sub Id
    v)
                ConCont
    cont

        go (Left InScopeSet
    in_scope) [FloatBind]
    floats (Var Id
    fun) cont :: ConCont
    cont@(CC [OutExpr]
    args MCoercion
    mco)

            | Just DataCon
    con <- Id -> Maybe DataCon
    isDataConWorkId_maybe Id
    fun
            , (OutExpr -> Bool) -> [OutExpr] -> BranchCount
    forall a. (a -> Bool) -> [a] -> BranchCount
    count OutExpr -> Bool
    forall b. Expr b -> Bool
    isValArg [OutExpr]
    args BranchCount -> BranchCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id -> BranchCount
    idArity Id
    fun
            = InScopeSet
    -> [FloatBind]
    -> Maybe (DataCon, [Type], [OutExpr])
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    succeedWith InScopeSet
    in_scope [FloatBind]
    floats (Maybe (DataCon, [Type], [OutExpr])
     -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr]))
    -> Maybe (DataCon, [Type], [OutExpr])
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    forall a b. (a -> b) -> a -> b
    $
              DataCon
    -> [OutExpr] -> MCoercion -> Maybe (DataCon, [Type], [OutExpr])
    pushCoDataCon DataCon
    con [OutExpr]
    args MCoercion
    mco

            -- Look through data constructor wrappers: they inline late (See Note
            -- [Activation for data constructor wrappers]) but we want to do
            -- case-of-known-constructor optimisation eagerly (see Note
            -- [exprIsConApp_maybe on data constructors with wrappers]).
            | Id -> Bool
    isDataConWrapId Id
    fun
            , let rhs :: OutExpr
    rhs = Unfolding -> OutExpr
    uf_tmpl (IdUnfoldingFun
    realIdUnfolding Id
    fun)
            = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go (InScopeSet -> Either InScopeSet Subst
    forall a b. a -> Either a b
    Left InScopeSet
    in_scope) [FloatBind]
    floats OutExpr
    rhs ConCont
    cont

            -- Look through dictionary functions; see Note [Unfolding DFuns]
            | DFunUnfolding { df_bndrs :: Unfolding -> [Id]
    df_bndrs = [Id]
    bndrs, df_con :: Unfolding -> DataCon
    df_con = DataCon
    con, df_args :: Unfolding -> [OutExpr]
    df_args = [OutExpr]
    dfun_args } <- Unfolding
    unfolding
            , [Id]
    bndrs [Id] -> [OutExpr] -> Bool
    forall a b. [a] -> [b] -> Bool
    `equalLength` [OutExpr]
    args    -- See Note [DFun arity check]
            , let in_scope' :: InScopeSet
    in_scope' = VarSet -> InScopeSet
    extend_in_scope ([OutExpr] -> VarSet
    exprsFreeVars [OutExpr]
    dfun_args)
                  subst :: Subst
    subst = InScopeSet -> [(Id, OutExpr)] -> Subst
    mkOpenSubst InScopeSet
    in_scope' ([Id]
    bndrs [Id] -> [OutExpr] -> [(Id, OutExpr)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [OutExpr]
    args)
                  -- We extend the in-scope set here to silence warnings from
                  -- substExpr when it finds not-in-scope Ids in dfun_args.
                  -- simplOptExpr initialises the in-scope set with exprFreeVars,
                  -- but that doesn't account for DFun unfoldings
            = InScopeSet
    -> [FloatBind]
    -> Maybe (DataCon, [Type], [OutExpr])
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    succeedWith InScopeSet
    in_scope [FloatBind]
    floats (Maybe (DataCon, [Type], [OutExpr])
     -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr]))
    -> Maybe (DataCon, [Type], [OutExpr])
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    forall a b. (a -> b) -> a -> b
    $
              DataCon
    -> [OutExpr] -> MCoercion -> Maybe (DataCon, [Type], [OutExpr])
    pushCoDataCon DataCon
    con ((OutExpr -> OutExpr) -> [OutExpr] -> [OutExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (HasDebugCallStack => Subst -> OutExpr -> OutExpr
    Subst -> OutExpr -> OutExpr
    substExpr Subst
    subst) [OutExpr]
    dfun_args) MCoercion
    mco

            -- Look through unfoldings, but only arity-zero one;
            -- if arity > 0 we are effectively inlining a function call,
            -- and that is the business of callSiteInline.
            -- In practice, without this test, most of the "hits" were
            -- CPR'd workers getting inlined back into their wrappers,
            | Id -> BranchCount
    idArity Id
    fun BranchCount -> BranchCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == BranchCount
    0
            , Just OutExpr
    rhs <- Unfolding -> Maybe OutExpr
    expandUnfolding_maybe Unfolding
    unfolding
            , let in_scope' :: InScopeSet
    in_scope' = VarSet -> InScopeSet
    extend_in_scope (OutExpr -> VarSet
    exprFreeVars OutExpr
    rhs)
            = Either InScopeSet Subst
    -> [FloatBind]
    -> OutExpr
    -> ConCont
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    go (InScopeSet -> Either InScopeSet Subst
    forall a b. a -> Either a b
    Left InScopeSet
    in_scope') [FloatBind]
    floats OutExpr
    rhs ConCont
    cont

            -- See Note [exprIsConApp_maybe on literal strings]
            | (Id
    fun Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    unpackCStringIdKey) Bool -> Bool -> Bool
    ||
              (Id
    fun Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    unpackCStringUtf8IdKey)
            , [OutExpr
    arg]              <- [OutExpr]
    args
            , Just (LitString ByteString
    str) <- InScopeEnv -> OutExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    ise OutExpr
    arg
            = InScopeSet
    -> [FloatBind]
    -> Maybe (DataCon, [Type], [OutExpr])
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    succeedWith InScopeSet
    in_scope [FloatBind]
    floats (Maybe (DataCon, [Type], [OutExpr])
     -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr]))
    -> Maybe (DataCon, [Type], [OutExpr])
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    forall a b. (a -> b) -> a -> b
    $
              Id -> ByteString -> MCoercion -> Maybe (DataCon, [Type], [OutExpr])
    dealWithStringLiteral Id
    fun ByteString
    str MCoercion
    mco
            where
              unfolding :: Unfolding
    unfolding = IdUnfoldingFun
    id_unf Id
    fun
              extend_in_scope :: VarSet -> InScopeSet
    extend_in_scope VarSet
    unf_fvs
                | Id -> Bool
    isLocalId Id
    fun = InScopeSet
    in_scope InScopeSet -> VarSet -> InScopeSet
    `extendInScopeSetSet` VarSet
    unf_fvs
                | Bool
    otherwise     = InScopeSet
    in_scope
                -- A GlobalId has no (LocalId) free variables; and the
                -- in-scope set tracks only LocalIds

        go Either InScopeSet Subst
    _ [FloatBind]
    _ OutExpr
    _ ConCont
    _ = Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    forall a. Maybe a
    Nothing

        succeedWith :: InScopeSet -> [FloatBind]
                    -> Maybe (DataCon, [Type], [CoreExpr])
                    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
        succeedWith :: InScopeSet
    -> [FloatBind]
    -> Maybe (DataCon, [Type], [OutExpr])
    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [OutExpr])
    succeedWith InScopeSet
    in_scope [FloatBind]
    rev_floats Maybe (DataCon, [Type], [OutExpr])
    x
          = do { (con, tys, args) <- Maybe (DataCon, [Type], [OutExpr])
    x
               ; let floats = [FloatBind] -> [FloatBind]
    forall a. [a] -> [a]
    reverse [FloatBind]
    rev_floats
               ; return (in_scope, floats, con, tys, args) }

        ----------------------------
        -- Operations on the (Either InScopeSet GHC.Core.Subst)
        -- The Left case is wildly dominant

        subst_in_scope :: Either InScopeSet Subst -> InScopeSet
    subst_in_scope (Left InScopeSet
    in_scope) = InScopeSet
    in_scope
        subst_in_scope (Right Subst
    s) = Subst -> InScopeSet
    getSubstInScope Subst
    s

        subst_extend_in_scope :: Either InScopeSet Subst -> Id -> Either InScopeSet Subst
    subst_extend_in_scope (Left InScopeSet
    in_scope) Id
    v = InScopeSet -> Either InScopeSet Subst
    forall a b. a -> Either a b
    Left (InScopeSet
    in_scope InScopeSet -> Id -> InScopeSet
    `extendInScopeSet` Id
    v)
        subst_extend_in_scope (Right Subst
    s) Id
    v = Subst -> Either InScopeSet Subst
    forall a b. b -> Either a b
    Right (Subst
    s Subst -> Id -> Subst
    `extendSubstInScope` Id
    v)

        subst_co :: Either a Subst -> Coercion -> Coercion
    subst_co (Left {}) Coercion
    co = Coercion
    co
        subst_co (Right Subst
    s) Coercion
    co = HasDebugCallStack => Subst -> Coercion -> Coercion
    Subst -> Coercion -> Coercion
    GHC.Core.Subst.substCo Subst
    s Coercion
    co

        subst_expr :: Either a Subst -> OutExpr -> OutExpr
    subst_expr (Left {}) OutExpr
    e = OutExpr
    e
        subst_expr (Right Subst
    s) OutExpr
    e = HasDebugCallStack => Subst -> OutExpr -> OutExpr
    Subst -> OutExpr -> OutExpr
    substExpr Subst
    s OutExpr
    e

        subst_bndr :: Either InScopeSet Subst -> Id -> (Either a Subst, Id)
    subst_bndr Either InScopeSet Subst
    msubst Id
    bndr
          = (Subst -> Either a Subst
    forall a b. b -> Either a b
    Right Subst
    subst', Id
    bndr')
          where
            (Subst
    subst', Id
    bndr') = Subst -> Id -> (Subst, Id)
    substBndr Subst
    subst Id
    bndr
            subst :: Subst
    subst = case Either InScopeSet Subst
    msubst of
                      Left InScopeSet
    in_scope -> InScopeSet -> Subst
    mkEmptySubst InScopeSet
    in_scope
                      Right Subst
    subst   -> Subst
    subst

        subst_bndrs :: Either InScopeSet Subst -> t Id -> (Either InScopeSet Subst, t Id)
    subst_bndrs Either InScopeSet Subst
    subst t Id
    bs = (Either InScopeSet Subst -> Id -> (Either InScopeSet Subst, Id))
    -> Either InScopeSet Subst
    -> t Id
    -> (Either InScopeSet Subst, t Id)
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL Either InScopeSet Subst -> Id -> (Either InScopeSet Subst, Id)
    forall {a}. Either InScopeSet Subst -> Id -> (Either a Subst, Id)
    subst_bndr Either InScopeSet Subst
    subst t Id
    bs

        extend :: Either InScopeSet Subst -> Id -> OutExpr -> Either a Subst
    extend (Left InScopeSet
    in_scope) Id
    v OutExpr
    e = Subst -> Either a Subst
    forall a b. b -> Either a b
    Right (Subst -> Id -> OutExpr -> Subst
    extendSubst (InScopeSet -> Subst
    mkEmptySubst InScopeSet
    in_scope) Id
    v OutExpr
    e)
        extend (Right Subst
    s)       Id
    v OutExpr
    e = Subst -> Either a Subst
    forall a b. b -> Either a b
    Right (Subst -> Id -> OutExpr -> Subst
    extendSubst Subst
    s Id
    v OutExpr
    e)

    -- See Note [exprIsConApp_maybe on literal strings]
    dealWithStringLiteral :: Var -> BS.ByteString -> MCoercion
                          -> Maybe (DataCon, [Type], [CoreExpr])

    -- This is not possible with user-supplied empty literals, GHC.Core.Make.mkStringExprFS
    -- turns those into [] automatically, but just in case something else in GHC
    -- generates a string literal directly.
    dealWithStringLiteral :: Id -> ByteString -> MCoercion -> Maybe (DataCon, [Type], [OutExpr])
    dealWithStringLiteral Id
    fun ByteString
    str MCoercion
    mco =
      case ByteString -> Maybe (Char, ByteString)
    utf8UnconsByteString ByteString
    str of
        Maybe (Char, ByteString)
    Nothing -> DataCon
    -> [OutExpr] -> MCoercion -> Maybe (DataCon, [Type], [OutExpr])
    pushCoDataCon DataCon
    nilDataCon [Type -> OutExpr
    forall b. Type -> Expr b
    Type Type
    charTy] MCoercion
    mco
        Just (Char
    char, ByteString
    charTail) ->
          let char_expr :: OutExpr
    char_expr = DataCon -> [OutExpr] -> OutExpr
    forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    charDataCon [Char -> OutExpr
    forall b. Char -> Expr b
    mkCharLit Char
    char]
              -- In singleton strings, just add [] instead of unpackCstring# ""#.
              rest :: OutExpr
    rest = if ByteString -> Bool
    BS.null ByteString
    charTail
                       then DataCon -> [OutExpr] -> OutExpr
    forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    nilDataCon [Type -> OutExpr
    forall b. Type -> Expr b
    Type Type
    charTy]
                       else OutExpr -> OutExpr -> OutExpr
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> OutExpr
    forall b. Id -> Expr b
    Var Id
    fun)
                                (Literal -> OutExpr
    forall b. Literal -> Expr b
    Lit (ByteString -> Literal
    LitString ByteString
    charTail))

          in DataCon
    -> [OutExpr] -> MCoercion -> Maybe (DataCon, [Type], [OutExpr])
    pushCoDataCon DataCon
    consDataCon [Type -> OutExpr
    forall b. Type -> Expr b
    Type Type
    charTy, OutExpr
    char_expr, OutExpr
    rest] MCoercion
    mco

    {-
    Note [Case elim in exprIsConApp_maybe]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have
       data K a = MkK !a

       $WMkK x = case x of y -> K y   -- Wrapper for MkK

       ...case $WMkK v of K w -> <rhs>

    We call `exprIsConApp_maybe` on ($WMkK v); we inline the wrapper
    and beta-reduce, so we get to
       exprIsConApp_maybe (case v of y -> K y)

    So we may float the case, and end up with
       case v of y -> <rhs>[y/w]

    But if `v` is already evaluated, the next run of the Simplifier will
    eliminate the case, and we may then make more progress with <rhs>.
    Better to do it in one iteration.  Hence the `do_case_elim`
    check in `exprIsConApp_maybe`.

    Note [Unfolding DFuns]
    ~~~~~~~~~~~~~~~~~~~~~~
    DFuns look like

      df :: forall a b. (Eq a, Eq b) -> Eq (a,b)
      df a b d_a d_b = MkEqD (a,b) ($c1 a b d_a d_b)
                                   ($c2 a b d_a d_b)

    So to split it up we just need to apply the ops $c1, $c2 etc
    to the very same args as the dfun.  It takes a little more work
    to compute the type arguments to the dictionary constructor.

    Note [DFun arity check]
    ~~~~~~~~~~~~~~~~~~~~~~~
    Here we check that the total number of supplied arguments (including
    type args) matches what the dfun is expecting.  This may be *less*
    than the ordinary arity of the dfun: see Note [DFun unfoldings] in GHC.Core
    -}

    exprIsLiteral_maybe :: InScopeEnv -> CoreExpr -> Maybe Literal
    -- Same deal as exprIsConApp_maybe, but much simpler
    -- Nevertheless we do need to look through unfoldings for
    -- string literals, which are vigorously hoisted to top level
    -- and not subsequently inlined
    exprIsLiteral_maybe :: InScopeEnv -> OutExpr -> Maybe Literal
    exprIsLiteral_maybe env :: InScopeEnv
    env@(ISE InScopeSet
    _ IdUnfoldingFun
    id_unf) OutExpr
    e
      = case OutExpr
    e of
          Lit Literal
    l     -> Literal -> Maybe Literal
    forall a. a -> Maybe a
    Just Literal
    l
          Tick CoreTickish
    _ OutExpr
    e' -> InScopeEnv -> OutExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env OutExpr
    e' -- dubious?
          Var Id
    v     -> Unfolding -> Maybe OutExpr
    expandUnfolding_maybe (IdUnfoldingFun
    id_unf Id
    v)
                        Maybe OutExpr -> (OutExpr -> Maybe Literal) -> Maybe Literal
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= InScopeEnv -> OutExpr -> Maybe Literal
    exprIsLiteral_maybe InScopeEnv
    env
          OutExpr
    _         -> Maybe Literal
    forall a. Maybe a
    Nothing

    {-
    Note [exprIsLambda_maybe]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    exprIsLambda_maybe will, given an expression `e`, try to turn it into the form
    `Lam v e'` (returned as `Just (v,e')`). Besides using lambdas, it looks through
    casts (using the Push rule), and it unfolds function calls if the unfolding
    has a greater arity than arguments are present.

    Currently, it is used in GHC.Core.Rules.match, and is required to make
    "map coerce = coerce" match.
    -}

    exprIsLambda_maybe :: HasDebugCallStack
                       => InScopeEnv -> CoreExpr
                       -> Maybe (Var, CoreExpr,[CoreTickish])
        -- See Note [exprIsLambda_maybe]

    -- The simple case: It is a lambda already
    exprIsLambda_maybe :: HasDebugCallStack =>
    InScopeEnv -> OutExpr -> Maybe (Id, OutExpr, [CoreTickish])
    exprIsLambda_maybe InScopeEnv
    _ (Lam Id
    x OutExpr
    e)
        = (Id, OutExpr, [CoreTickish]) -> Maybe (Id, OutExpr, [CoreTickish])
    forall a. a -> Maybe a
    Just (Id
    x, OutExpr
    e, [])

    -- Still straightforward: Ticks that we can float out of the way
    exprIsLambda_maybe InScopeEnv
    ise (Tick CoreTickish
    t OutExpr
    e)
        | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreTickish
    t
        , Just (Id
    x, OutExpr
    e, [CoreTickish]
    ts) <- HasDebugCallStack =>
    InScopeEnv -> OutExpr -> Maybe (Id, OutExpr, [CoreTickish])
    InScopeEnv -> OutExpr -> Maybe (Id, OutExpr, [CoreTickish])
    exprIsLambda_maybe InScopeEnv
    ise OutExpr
    e
        = (Id, OutExpr, [CoreTickish]) -> Maybe (Id, OutExpr, [CoreTickish])
    forall a. a -> Maybe a
    Just (Id
    x, OutExpr
    e, CoreTickish
    tCoreTickish -> [CoreTickish] -> [CoreTickish]
    forall a. a -> [a] -> [a]
    :[CoreTickish]
    ts)

    -- Also possible: A casted lambda. Push the coercion inside
    exprIsLambda_maybe ise :: InScopeEnv
    ise@(ISE InScopeSet
    in_scope_set IdUnfoldingFun
    _) (Cast OutExpr
    casted_e Coercion
    co)
        | Just (Id
    x, OutExpr
    e,[CoreTickish]
    ts) <- HasDebugCallStack =>
    InScopeEnv -> OutExpr -> Maybe (Id, OutExpr, [CoreTickish])
    InScopeEnv -> OutExpr -> Maybe (Id, OutExpr, [CoreTickish])
    exprIsLambda_maybe InScopeEnv
    ise OutExpr
    casted_e
        -- Only do value lambdas.
        -- this implies that x is not in scope in gamma (makes this code simpler)
        , Bool -> Bool
    not (Id -> Bool
    isTyVar Id
    x) Bool -> Bool -> Bool
    && Bool -> Bool
    not (Id -> Bool
    isCoVar Id
    x)
        , Bool -> Bool -> Bool
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Id
    x Id -> VarSet -> Bool
    `elemVarSet` Coercion -> VarSet
    tyCoVarsOfCo Coercion
    co) Bool
    True
        , Just (Id
    x',OutExpr
    e') <- HasDebugCallStack =>
    InScopeSet -> Id -> OutExpr -> Coercion -> Maybe (Id, OutExpr)
    InScopeSet -> Id -> OutExpr -> Coercion -> Maybe (Id, OutExpr)
    pushCoercionIntoLambda InScopeSet
    in_scope_set Id
    x OutExpr
    e Coercion
    co
        , let res :: Maybe (Id, OutExpr, [CoreTickish])
    res = (Id, OutExpr, [CoreTickish]) -> Maybe (Id, OutExpr, [CoreTickish])
    forall a. a -> Maybe a
    Just (Id
    x',OutExpr
    e',[CoreTickish]
    ts)
        = --pprTrace "exprIsLambda_maybe:Cast" (vcat [ppr casted_e,ppr co,ppr res)])
          Maybe (Id, OutExpr, [CoreTickish])
    res

    -- Another attempt: See if we find a partial unfolding
    exprIsLambda_maybe ise :: InScopeEnv
    ise@(ISE InScopeSet
    in_scope_set IdUnfoldingFun
    id_unf) OutExpr
    e
        | (Var Id
    f, [OutExpr]
    as, [CoreTickish]
    ts) <- (CoreTickish -> Bool)
    -> OutExpr -> (OutExpr, [OutExpr], [CoreTickish])
    forall b.
    (CoreTickish -> Bool)
    -> Expr b -> (Expr b, [Expr b], [CoreTickish])
    collectArgsTicks CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable OutExpr
    e
        , Id -> BranchCount
    idArity Id
    f BranchCount -> BranchCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > (OutExpr -> Bool) -> [OutExpr] -> BranchCount
    forall a. (a -> Bool) -> [a] -> BranchCount
    count OutExpr -> Bool
    forall b. Expr b -> Bool
    isValArg [OutExpr]
    as
        -- Make sure there is hope to get a lambda
        , Just OutExpr
    rhs <- Unfolding -> Maybe OutExpr
    expandUnfolding_maybe (IdUnfoldingFun
    id_unf Id
    f)
        -- Optimize, for beta-reduction
        , let e' :: OutExpr
    e' = HasDebugCallStack => SimpleOpts -> Subst -> OutExpr -> OutExpr
    SimpleOpts -> Subst -> OutExpr -> OutExpr
    simpleOptExprWith SimpleOpts
    defaultSimpleOpts (InScopeSet -> Subst
    mkEmptySubst InScopeSet
    in_scope_set) (OutExpr
    rhs OutExpr -> [OutExpr] -> OutExpr
    forall b. Expr b -> [Expr b] -> Expr b
    `mkApps` [OutExpr]
    as)
        -- Recurse, because of possible casts
        , Just (Id
    x', OutExpr
    e'', [CoreTickish]
    ts') <- HasDebugCallStack =>
    InScopeEnv -> OutExpr -> Maybe (Id, OutExpr, [CoreTickish])
    InScopeEnv -> OutExpr -> Maybe (Id, OutExpr, [CoreTickish])
    exprIsLambda_maybe InScopeEnv
    ise OutExpr
    e'
        , let res :: Maybe (Id, OutExpr, [CoreTickish])
    res = (Id, OutExpr, [CoreTickish]) -> Maybe (Id, OutExpr, [CoreTickish])
    forall a. a -> Maybe a
    Just (Id
    x', OutExpr
    e'', [CoreTickish]
    ts[CoreTickish] -> [CoreTickish] -> [CoreTickish]
    forall a. [a] -> [a] -> [a]
    ++[CoreTickish]
    ts')
        = -- pprTrace "exprIsLambda_maybe:Unfold" (vcat [ppr e, ppr (x',e'')])
          Maybe (Id, OutExpr, [CoreTickish])
    res

    exprIsLambda_maybe InScopeEnv
    _ OutExpr
    _e
        = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e])
          Maybe (Id, OutExpr, [CoreTickish])
    forall a. Maybe a
    Nothing