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

    Utility functions on @Core@ syntax
    -}

    -- | Commonly useful utilities for manipulating the Core language
    module GHC.Core.Utils (
            -- * Constructing expressions
            mkCast, mkCastMCo, mkPiMCo,
            mkTick, mkTicks, mkTickNoHNF, tickHNFArgs,
            bindNonRec, needsCaseBinding, needsCaseBindingL,
            mkAltExpr, mkDefaultCase, mkSingleAltCase,

            -- * Taking expressions apart
            findDefault, addDefault, findAlt, isDefaultAlt,
            mergeAlts, mergeCaseAlts, trimConArgs,
            filterAlts, combineIdenticalAlts, refineDefaultAlt,
            scaleAltsBy,

            -- * Properties of expressions
            exprType, coreAltType, coreAltsType,
            mkLamType, mkLamTypes,
            mkFunctionType,
            exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe,
            trivial_expr_fold,
            exprIsDupable, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
            exprIsHNF, exprOkForSpeculation, exprOkToDiscard, exprOkForSpecEval,
            exprIsWorkFree, exprIsConLike,
            isCheapApp, isExpandableApp, isSaturatedConApp,
            exprIsTickedString, exprIsTickedString_maybe,
            exprIsTopLevelBindable,
            altsAreExhaustive, etaExpansionTick,

            -- * Equality
            cheapEqExpr, cheapEqExpr', diffBinds,

            -- * Manipulating data constructors and types
            exprToType,
            applyTypeToArgs,
            dataConRepInstPat, dataConRepFSInstPat,
            isEmptyTy, normSplitTyConApp_maybe,

            -- * Working with ticks
            stripTicksTop, stripTicksTopE, stripTicksTopT,
            stripTicksE, stripTicksT,

            -- * InScopeSet things which work over CoreBinds
            mkInScopeSetBndrs, extendInScopeSetBind, extendInScopeSetBndrs,

            -- * StaticPtr
            collectMakeStaticArgs,

            -- * Join points
            isJoinBind,

            -- * Tag inference
            mkStrictFieldSeqs, shouldStrictifyIdForCbv, shouldUseCbvForId,

            -- * unsafeEqualityProof
            isUnsafeEqualityCase,

            -- * Dumping stuff
            dumpIdInfoOfProgram
        ) where

    import GHC.Prelude
    import GHC.Platform

    import GHC.Core
    import GHC.Core.Ppr
    import GHC.Core.FVs( bindFreeVars )
    import GHC.Core.DataCon
    import GHC.Core.Type as Type
    import GHC.Core.Predicate( isCoVarType )
    import GHC.Core.FamInstEnv
    import GHC.Core.TyCo.Compare( eqType, eqTypeX )
    import GHC.Core.Coercion
    import GHC.Core.Reduction
    import GHC.Core.TyCon
    import GHC.Core.Multiplicity

    import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofIdKey, unsafeReflDataConKey )
    import GHC.Builtin.PrimOps

    import GHC.Types.Var
    import GHC.Types.SrcLoc
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set
    import GHC.Types.Name
    import GHC.Types.Literal
    import GHC.Types.Tickish
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Types.Basic( Arity )
    import GHC.Types.Unique
    import GHC.Types.Unique.Set
    import GHC.Types.Demand
    import GHC.Types.RepType (isZeroBitTy)

    import GHC.Data.FastString
    import GHC.Data.Maybe
    import GHC.Data.List.SetOps( minusList )
    import GHC.Data.OrdList

    import GHC.Utils.Constants (debugIsOn)
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc

    import Data.ByteString     ( ByteString )
    import Data.Function       ( on )
    import Data.List           ( sort, sortBy, partition, zipWith4, mapAccumL )
    import Data.Ord            ( comparing )
    import Control.Monad       ( guard )
    import qualified Data.Set as Set

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Find the type of a Core atom/expression}
    *                                                                      *
    ************************************************************************
    -}

    exprType :: HasDebugCallStack => CoreExpr -> Type
    -- ^ Recover the type of a well-typed Core expression. Fails when
    -- applied to the actual 'GHC.Core.Type' expression as it cannot
    -- really be said to have a type
    exprType :: HasDebugCallStack => CoreExpr -> Type
    exprType (Var Id
    var)           = Id -> Type
    idType Id
    var
    exprType (Lit Literal
    lit)           = Literal -> Type
    literalType Literal
    lit
    exprType (Coercion Coercion
    co)       = Coercion -> Type
    coercionType Coercion
    co
    exprType (Let Bind Id
    bind CoreExpr
    body)
      | NonRec Id
    tv CoreExpr
    rhs <- Bind Id
    bind    -- See Note [Type bindings]
      , Type Type
    ty <- CoreExpr
    rhs           = [Id] -> [Type] -> Type -> Type
    substTyWithUnchecked [Id
    tv] [Type
    ty] (HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    body)
      | Bool
    otherwise                = HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    body
    exprType (Case CoreExpr
    _ Id
    _ Type
    ty [Alt Id]
    _)     = Type
    ty
    exprType (Cast CoreExpr
    _ Coercion
    co)         = HasDebugCallStack => Coercion -> Type
    Coercion -> Type
    coercionRKind Coercion
    co
    exprType (Tick CoreTickish
    _ CoreExpr
    e)          = HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    e
    exprType (Lam Id
    binder CoreExpr
    expr)   = HasDebugCallStack => Id -> Type -> Type
    Id -> Type -> Type
    mkLamType Id
    binder (HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    expr)
    exprType e :: CoreExpr
    e@(App CoreExpr
    _ CoreExpr
    _)
      = case CoreExpr -> (CoreExpr, [CoreExpr])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs CoreExpr
    e of
            (CoreExpr
    fun, [CoreExpr]
    args) -> HasDebugCallStack => SDoc -> Type -> [CoreExpr] -> Type
    SDoc -> Type -> [CoreExpr] -> Type
    applyTypeToArgs (CoreExpr -> SDoc
    forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr CoreExpr
    e) (HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    fun) [CoreExpr]
    args
    exprType (Type Type
    ty) = String -> SDoc -> Type
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "exprType" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)

    coreAltType :: CoreAlt -> Type
    -- ^ Returns the type of the alternatives right hand side
    coreAltType :: Alt Id -> Type
    coreAltType alt :: Alt Id
    alt@(Alt AltCon
    _ [Id]
    bs CoreExpr
    rhs)
      = case [Id] -> Type -> Maybe Type
    occCheckExpand [Id]
    bs Type
    rhs_ty of
          -- Note [Existential variables and silly type synonyms]
          Just Type
    ty -> Type
    ty
          Maybe Type
    Nothing -> String -> SDoc -> Type
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "coreAltType" (Alt Id -> SDoc
    forall a. OutputableBndr a => Alt a -> SDoc
    pprCoreAlt Alt Id
    alt SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    rhs_ty)
      where
        rhs_ty :: Type
    rhs_ty = HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    rhs

    coreAltsType :: [CoreAlt] -> Type
    -- ^ Returns the type of the first alternative, which should be the same as for all alternatives
    coreAltsType :: [Alt Id] -> Type
    coreAltsType (Alt Id
    alt:[Alt Id]
    _) = Alt Id -> Type
    coreAltType Alt Id
    alt
    coreAltsType []      = String -> Type
    forall a. HasCallStack => String -> a
    panic String
    "coreAltsType"

    mkLamType  :: HasDebugCallStack => Var -> Type -> Type
    -- ^ Makes a @(->)@ type or an implicit forall type, depending
    -- on whether it is given a type variable or a term variable.
    -- This is used, for example, when producing the type of a lambda.
    --
    mkLamTypes :: [Var] -> Type -> Type
    -- ^ 'mkLamType' for multiple type or value arguments

    mkLamType :: HasDebugCallStack => Id -> Type -> Type
    mkLamType Id
    v Type
    body_ty
       | Id -> Bool
    isTyVar Id
    v
       = ForAllTyBinder -> Type -> Type
    mkForAllTy (Id -> ForAllTyFlag -> ForAllTyBinder
    forall var argf. var -> argf -> VarBndr var argf
    Bndr Id
    v ForAllTyFlag
    coreTyLamForAllTyFlag) Type
    body_ty
         -- coreTyLamForAllTyFlag: see Note [Required foralls in Core]
         --                        in GHC.Core.TyCo.Rep

       | Id -> Bool
    isCoVar Id
    v
       , Id
    v Id -> VarSet -> Bool
    `elemVarSet` Type -> VarSet
    tyCoVarsOfType Type
    body_ty
         -- See Note [Unused coercion variable in ForAllTy] in GHC.Core.TyCo.Rep
       = ForAllTyBinder -> Type -> Type
    mkForAllTy (Id -> ForAllTyFlag -> ForAllTyBinder
    forall var argf. var -> argf -> VarBndr var argf
    Bndr Id
    v ForAllTyFlag
    coreTyLamForAllTyFlag) Type
    body_ty

       | Bool
    otherwise
       = HasDebugCallStack => Type -> Type -> Type -> Type
    Type -> Type -> Type -> Type
    mkFunctionType (Id -> Type
    varMult Id
    v) (Id -> Type
    varType Id
    v) Type
    body_ty

    mkLamTypes :: [Id] -> Type -> Type
    mkLamTypes [Id]
    vs Type
    ty = (Id -> Type -> Type) -> Type -> [Id] -> Type
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr HasDebugCallStack => Id -> Type -> Type
    Id -> Type -> Type
    mkLamType Type
    ty [Id]
    vs

    {-
    Note [Type bindings]
    ~~~~~~~~~~~~~~~~~~~~
    Core does allow type bindings, although such bindings are
    not much used, except in the output of the desugarer.
    Example:
         let a = Int in (\x:a. x)
    Given this, exprType must be careful to substitute 'a' in the
    result type (#8522).

    Note [Existential variables and silly type synonyms]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
            data T = forall a. T (Funny a)
            type Funny a = Bool
            f :: T -> Bool
            f (T x) = x

    Now, the type of 'x' is (Funny a), where 'a' is existentially quantified.
    That means that 'exprType' and 'coreAltsType' may give a result that *appears*
    to mention an out-of-scope type variable.  See #3409 for a more real-world
    example.

    Various possibilities suggest themselves:

     - Ignore the problem, and make Lint not complain about such variables

     - Expand all type synonyms (or at least all those that discard arguments)
          This is tricky, because at least for top-level things we want to
          retain the type the user originally specified.

     - Expand synonyms on the fly, when the problem arises. That is what
       we are doing here.  It's not too expensive, I think.

    Note that there might be existentially quantified coercion variables, too.
    -}

    applyTypeToArgs :: HasDebugCallStack => SDoc -> Type -> [CoreExpr] -> Type
    -- ^ Determines the type resulting from applying an expression with given type
    --- to given argument expressions.
    -- The first argument is just for debugging, and gives some context
    applyTypeToArgs :: HasDebugCallStack => SDoc -> Type -> [CoreExpr] -> Type
    applyTypeToArgs SDoc
    pp_e Type
    op_ty [CoreExpr]
    args
      = Type -> [CoreExpr] -> Type
    go Type
    op_ty [CoreExpr]
    args
      where
        go :: Type -> [CoreExpr] -> Type
    go Type
    op_ty []                   = Type
    op_ty
        go Type
    op_ty (Type Type
    ty : [CoreExpr]
    args)     = Type -> [Type] -> [CoreExpr] -> Type
    go_ty_args Type
    op_ty [Type
    ty] [CoreExpr]
    args
        go Type
    op_ty (Coercion Coercion
    co : [CoreExpr]
    args) = Type -> [Type] -> [CoreExpr] -> Type
    go_ty_args Type
    op_ty [Coercion -> Type
    mkCoercionTy Coercion
    co] [CoreExpr]
    args
        go Type
    op_ty (CoreExpr
    _ : [CoreExpr]
    args)           | Just (FunTyFlag
    _, Type
    _, Type
    _, Type
    res_ty) <- Type -> Maybe (FunTyFlag, Type, Type, Type)
    splitFunTy_maybe Type
    op_ty
                                      = Type -> [CoreExpr] -> Type
    go Type
    res_ty [CoreExpr]
    args
        go Type
    _ [CoreExpr]
    args = String -> SDoc -> Type
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "applyTypeToArgs" ([CoreExpr] -> SDoc
    panic_msg [CoreExpr]
    args)

        -- go_ty_args: accumulate type arguments so we can
        -- instantiate all at once with piResultTys
        go_ty_args :: Type -> [Type] -> [CoreExpr] -> Type
    go_ty_args Type
    op_ty [Type]
    rev_tys (Type Type
    ty : [CoreExpr]
    args)
           = Type -> [Type] -> [CoreExpr] -> Type
    go_ty_args Type
    op_ty (Type
    tyType -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    :[Type]
    rev_tys) [CoreExpr]
    args
        go_ty_args Type
    op_ty [Type]
    rev_tys (Coercion Coercion
    co : [CoreExpr]
    args)
           = Type -> [Type] -> [CoreExpr] -> Type
    go_ty_args Type
    op_ty (Coercion -> Type
    mkCoercionTy Coercion
    co Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : [Type]
    rev_tys) [CoreExpr]
    args
        go_ty_args Type
    op_ty [Type]
    rev_tys [CoreExpr]
    args
           = Type -> [CoreExpr] -> Type
    go (HasDebugCallStack => Type -> [Type] -> Type
    Type -> [Type] -> Type
    piResultTys Type
    op_ty ([Type] -> [Type]
    forall a. [a] -> [a]
    reverse [Type]
    rev_tys)) [CoreExpr]
    args

        panic_msg :: [CoreExpr] -> SDoc
    panic_msg [CoreExpr]
    as = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Expression:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    pp_e
                            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Type:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    op_ty
                            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Args:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    args
                            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Args':" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    as ]

    mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr
    mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr
    mkCastMCo CoreExpr
    e MCoercionR
    MRefl    = CoreExpr
    e
    mkCastMCo CoreExpr
    e (MCo Coercion
    co) = CoreExpr -> Coercion -> CoreExpr
    forall b. Expr b -> Coercion -> Expr b
    Cast CoreExpr
    e Coercion
    co
      -- We are careful to use (MCo co) only when co is not reflexive
      -- Hence (Cast e co) rather than (mkCast e co)

    mkPiMCo :: Var -> MCoercionR -> MCoercionR
    mkPiMCo :: Id -> MCoercionR -> MCoercionR
    mkPiMCo Id
    _  MCoercionR
    MRefl   = MCoercionR
    MRefl
    mkPiMCo Id
    v (MCo Coercion
    co) = Coercion -> MCoercionR
    MCo (Role -> Id -> Coercion -> Coercion
    mkPiCo Role
    Representational Id
    v Coercion
    co)

    {- *********************************************************************
    *                                                                      *
                 Casts
    *                                                                      *
    ********************************************************************* -}

    -- | Wrap the given expression in the coercion safely, dropping
    -- identity coercions and coalescing nested coercions
    mkCast :: HasDebugCallStack => CoreExpr -> CoercionR -> CoreExpr

    mkCast :: HasDebugCallStack => CoreExpr -> Coercion -> CoreExpr
    mkCast CoreExpr
    expr Coercion
    co
      = Bool -> SDoc -> CoreExpr -> CoreExpr
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Coercion -> Role
    coercionRole Coercion
    co Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    Representational)
                  (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "coercion" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Coercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Coercion
    co SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "passed to mkCast"
                   SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    expr SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "has wrong role" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Coercion -> Role
    coercionRole Coercion
    co)) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        Bool -> String -> SDoc -> CoreExpr -> CoreExpr
    forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
    warnPprTrace (Bool -> Bool
    not (HasDebugCallStack => Coercion -> Type
    Coercion -> Type
    coercionLKind Coercion
    co HasCallStack => Type -> Type -> Bool
    Type -> Type -> Bool
    `eqType` HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    expr))
              String
    "Trying to coerce" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "(" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    expr
              SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "::" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    expr) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ")"
              SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Coercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Coercion
    co SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Coercion -> Type
    coercionType Coercion
    co)
              SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc
    HasCallStack => SDoc
    callStackDoc) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        case CoreExpr
    expr of
          Cast CoreExpr
    expr Coercion
    co2 -> HasDebugCallStack => CoreExpr -> Coercion -> CoreExpr
    CoreExpr -> Coercion -> CoreExpr
    mkCast CoreExpr
    expr (HasDebugCallStack => Coercion -> Coercion -> Coercion
    Coercion -> Coercion -> Coercion
    mkTransCo Coercion
    co2 Coercion
    co)
          Tick CoreTickish
    t CoreExpr
    expr   -> CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t (HasDebugCallStack => CoreExpr -> Coercion -> CoreExpr
    CoreExpr -> Coercion -> CoreExpr
    mkCast CoreExpr
    expr Coercion
    co)

          Coercion Coercion
    e_co | Type -> Bool
    isCoVarType (HasDebugCallStack => Coercion -> Type
    Coercion -> Type
    coercionRKind Coercion
    co)
             -- The guard here checks that g has a (~#) on both sides,
             -- otherwise decomposeCo fails.  Can in principle happen
             -- with unsafeCoerce
                          -> Coercion -> CoreExpr
    forall b. Coercion -> Expr b
    Coercion (Coercion -> Coercion -> Coercion
    mkCoCast Coercion
    e_co Coercion
    co)

          CoreExpr
    _ | Coercion -> Bool
    isReflCo Coercion
    co -> CoreExpr
    expr
            | Bool
    otherwise   -> CoreExpr -> Coercion -> CoreExpr
    forall b. Expr b -> Coercion -> Expr b
    Cast CoreExpr
    expr Coercion
    co

    {- *********************************************************************
    *                                                                      *
                 Attaching ticks
    *                                                                      *
    ********************************************************************* -}

    -- | Wraps the given expression in the source annotation, dropping the
    -- annotation if possible.
    mkTick :: CoreTickish -> CoreExpr -> CoreExpr
    mkTick :: CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreTickish
    t CoreExpr
    orig_expr = (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    mkTick' CoreExpr -> CoreExpr
    forall a. a -> a
    id CoreExpr -> CoreExpr
    forall a. a -> a
    id CoreExpr
    orig_expr
     where
      -- Some ticks (cost-centres) can be split in two, with the
      -- non-counting part having laxer placement properties.
      canSplit :: Bool
    canSplit = CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCanSplit CoreTickish
    t Bool -> Bool -> Bool
    && CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace (CoreTickish -> CoreTickish
    forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoCount CoreTickish
    t) TickishPlacement -> TickishPlacement -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    t

      -- mkTick' handles floating of ticks *into* the expression.
      -- In this function, `top` is applied after adding the tick, and `rest` before.
      -- This will result in applications that look like (top $ Tick t $ rest expr).
      -- If we want to push the tick deeper, we pre-compose `top` with a function
      -- adding the tick.
      mkTick' :: (CoreExpr -> CoreExpr) -- apply after adding tick (float through)
              -> (CoreExpr -> CoreExpr) -- apply before adding tick (float with)
              -> CoreExpr               -- current expression
              -> CoreExpr
      mkTick' :: (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    mkTick' CoreExpr -> CoreExpr
    top CoreExpr -> CoreExpr
    rest CoreExpr
    expr = case CoreExpr
    expr of

        -- Cost centre ticks should never be reordered relative to each
        -- other. Therefore we can stop whenever two collide.
        Tick CoreTickish
    t2 CoreExpr
    e
          | ProfNote{} <- CoreTickish
    t2, ProfNote{} <- CoreTickish
    t -> CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> CoreExpr
    rest CoreExpr
    expr

        -- Otherwise we assume that ticks of different placements float
        -- through each other.
          | CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    t2 TickishPlacement -> TickishPlacement -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    t -> (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    mkTick' (CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t2) CoreExpr -> CoreExpr
    rest CoreExpr
    e

        -- For annotations this is where we make sure to not introduce
        -- redundant ticks.
          | CoreTickish -> CoreTickish -> Bool
    forall (pass :: TickishPass).
    Eq (GenTickish pass) =>
    GenTickish pass -> GenTickish pass -> Bool
    tickishContains CoreTickish
    t CoreTickish
    t2              -> (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    mkTick' CoreExpr -> CoreExpr
    top CoreExpr -> CoreExpr
    rest CoreExpr
    e
          | CoreTickish -> CoreTickish -> Bool
    forall (pass :: TickishPass).
    Eq (GenTickish pass) =>
    GenTickish pass -> GenTickish pass -> Bool
    tickishContains CoreTickish
    t2 CoreTickish
    t              -> CoreExpr
    orig_expr
          | Bool
    otherwise                         -> (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    mkTick' CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr
    rest (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t2) CoreExpr
    e

        -- Ticks don't care about types, so we just float all ticks
        -- through them. Note that it's not enough to check for these
        -- cases top-level. While mkTick will never produce Core with type
        -- expressions below ticks, such constructs can be the result of
        -- unfoldings. We therefore make an effort to put everything into
        -- the right place no matter what we start with.
        Cast CoreExpr
    e Coercion
    co   -> (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    mkTick' (CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CoreExpr -> Coercion -> CoreExpr)
    -> Coercion -> CoreExpr -> CoreExpr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip CoreExpr -> Coercion -> CoreExpr
    forall b. Expr b -> Coercion -> Expr b
    Cast Coercion
    co) CoreExpr -> CoreExpr
    rest CoreExpr
    e
        Coercion Coercion
    co -> Coercion -> CoreExpr
    forall b. Coercion -> Expr b
    Coercion Coercion
    co

        Lam Id
    x CoreExpr
    e
          -- Always float through type lambdas. Even for non-type lambdas,
          -- floating is allowed for all but the most strict placement rule.
          | Bool -> Bool
    not (Id -> Bool
    isRuntimeVar Id
    x) Bool -> Bool -> Bool
    || CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    t TickishPlacement -> TickishPlacement -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TickishPlacement
    PlaceRuntime
          -> (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    mkTick' (CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam Id
    x) CoreExpr -> CoreExpr
    rest CoreExpr
    e

          -- If it is both counting and scoped, we split the tick into its
          -- two components, often allowing us to keep the counting tick on
          -- the outside of the lambda and push the scoped tick inside.
          -- The point of this is that the counting tick can probably be
          -- floated, and the lambda may then be in a position to be
          -- beta-reduced.
          | Bool
    canSplit
          -> CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick (CoreTickish -> CoreTickish
    forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoScope CoreTickish
    t) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> CoreExpr
    rest (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ Id -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam Id
    x (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreTickish -> CoreExpr -> CoreExpr
    mkTick (CoreTickish -> CoreTickish
    forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoCount CoreTickish
    t) CoreExpr
    e

        App CoreExpr
    f CoreExpr
    arg
          -- Always float through type applications.
          | Bool -> Bool
    not (CoreExpr -> Bool
    isRuntimeArg CoreExpr
    arg)
          -> (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    mkTick' (CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CoreExpr -> CoreExpr -> CoreExpr)
    -> CoreExpr -> CoreExpr -> CoreExpr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    arg) CoreExpr -> CoreExpr
    rest CoreExpr
    f

          -- We can also float through constructor applications, placement
          -- permitting. Again we can split.
          | CoreExpr -> Bool
    isSaturatedConApp CoreExpr
    expr Bool -> Bool -> Bool
    && (CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    tTickishPlacement -> TickishPlacement -> Bool
    forall a. Eq a => a -> a -> Bool
    ==TickishPlacement
    PlaceCostCentre Bool -> Bool -> Bool
    || Bool
    canSplit)
          -> if CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    t TickishPlacement -> TickishPlacement -> Bool
    forall a. Eq a => a -> a -> Bool
    == TickishPlacement
    PlaceCostCentre
             then CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> CoreExpr
    rest (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreTickish -> CoreExpr -> CoreExpr
    tickHNFArgs CoreTickish
    t CoreExpr
    expr
             else CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick (CoreTickish -> CoreTickish
    forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoScope CoreTickish
    t) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> CoreExpr
    rest (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreTickish -> CoreExpr -> CoreExpr
    tickHNFArgs (CoreTickish -> CoreTickish
    forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoCount CoreTickish
    t) CoreExpr
    expr

        Var Id
    x
          | Bool
    notFunction Bool -> Bool -> Bool
    && CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    t TickishPlacement -> TickishPlacement -> Bool
    forall a. Eq a => a -> a -> Bool
    == TickishPlacement
    PlaceCostCentre
          -> CoreExpr
    orig_expr
          | Bool
    notFunction Bool -> Bool -> Bool
    && Bool
    canSplit
          -> CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick (CoreTickish -> CoreTickish
    forall (pass :: TickishPass). GenTickish pass -> GenTickish pass
    mkNoScope CoreTickish
    t) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> CoreExpr
    rest CoreExpr
    expr
          where
            -- SCCs can be eliminated on variables provided the variable
            -- is not a function.  In these cases the SCC makes no difference:
            -- the cost of evaluating the variable will be attributed to its
            -- definition site.  When the variable refers to a function, however,
            -- an SCC annotation on the variable affects the cost-centre stack
            -- when the function is called, so we must retain those.
            notFunction :: Bool
    notFunction = Bool -> Bool
    not (Type -> Bool
    isFunTy (Id -> Type
    idType Id
    x))

        Lit{}
          | CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    t TickishPlacement -> TickishPlacement -> Bool
    forall a. Eq a => a -> a -> Bool
    == TickishPlacement
    PlaceCostCentre
          -> CoreExpr
    orig_expr

        -- Catch-all: Annotate where we stand
        CoreExpr
    _any -> CoreExpr -> CoreExpr
    top (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> CoreExpr
    rest CoreExpr
    expr

    mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks [CoreTickish]
    ticks CoreExpr
    expr = (CoreTickish -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [CoreTickish] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreExpr
    expr [CoreTickish]
    ticks

    isSaturatedConApp :: CoreExpr -> Bool
    isSaturatedConApp :: CoreExpr -> Bool
    isSaturatedConApp CoreExpr
    e = CoreExpr -> [CoreExpr] -> Bool
    forall {b}. Expr b -> [Expr b] -> Bool
    go CoreExpr
    e []
      where go :: Expr b -> [Expr b] -> Bool
    go (App Expr b
    f Expr b
    a) [Expr b]
    as = Expr b -> [Expr b] -> Bool
    go Expr b
    f (Expr b
    aExpr b -> [Expr b] -> [Expr b]
    forall a. a -> [a] -> [a]
    :[Expr b]
    as)
            go (Var Id
    fun) [Expr b]
    args
               = Id -> Bool
    isConLikeId Id
    fun Bool -> Bool -> Bool
    && Id -> Int
    idArity Id
    fun Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Expr b] -> Int
    forall b. [Arg b] -> Int
    valArgCount [Expr b]
    args
            go (Cast Expr b
    f Coercion
    _) [Expr b]
    as = Expr b -> [Expr b] -> Bool
    go Expr b
    f [Expr b]
    as
            go Expr b
    _ [Expr b]
    _ = Bool
    False

    mkTickNoHNF :: CoreTickish -> CoreExpr -> CoreExpr
    mkTickNoHNF :: CoreTickish -> CoreExpr -> CoreExpr
    mkTickNoHNF CoreTickish
    t CoreExpr
    e
      | CoreExpr -> Bool
    exprIsHNF CoreExpr
    e = CoreTickish -> CoreExpr -> CoreExpr
    tickHNFArgs CoreTickish
    t CoreExpr
    e
      | Bool
    otherwise   = CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreTickish
    t CoreExpr
    e

    -- push a tick into the arguments of a HNF (call or constructor app)
    tickHNFArgs :: CoreTickish -> CoreExpr -> CoreExpr
    tickHNFArgs :: CoreTickish -> CoreExpr -> CoreExpr
    tickHNFArgs CoreTickish
    t CoreExpr
    e = CoreTickish -> CoreExpr -> CoreExpr
    push CoreTickish
    t CoreExpr
    e
     where
      push :: CoreTickish -> CoreExpr -> CoreExpr
    push CoreTickish
    t (App CoreExpr
    f (Type Type
    u)) = CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (CoreTickish -> CoreExpr -> CoreExpr
    push CoreTickish
    t CoreExpr
    f) (Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    u)
      push CoreTickish
    t (App CoreExpr
    f CoreExpr
    arg) = CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (CoreTickish -> CoreExpr -> CoreExpr
    push CoreTickish
    t CoreExpr
    f) (CoreTickish -> CoreExpr -> CoreExpr
    mkTick CoreTickish
    t CoreExpr
    arg)
      push CoreTickish
    _t CoreExpr
    e = CoreExpr
    e

    -- | Strip ticks satisfying a predicate from top of an expression
    stripTicksTop :: (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
    stripTicksTop :: forall b.
    (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
    stripTicksTop CoreTickish -> Bool
    p = [CoreTickish] -> Expr b -> ([CoreTickish], Expr b)
    go []
      where go :: [CoreTickish] -> Expr b -> ([CoreTickish], Expr b)
    go [CoreTickish]
    ts (Tick CoreTickish
    t Expr b
    e) | CoreTickish -> Bool
    p CoreTickish
    t = [CoreTickish] -> Expr b -> ([CoreTickish], Expr b)
    go (CoreTickish
    tCoreTickish -> [CoreTickish] -> [CoreTickish]
    forall a. a -> [a] -> [a]
    :[CoreTickish]
    ts) Expr b
    e
            go [CoreTickish]
    ts Expr b
    other            = ([CoreTickish] -> [CoreTickish]
    forall a. [a] -> [a]
    reverse [CoreTickish]
    ts, Expr b
    other)

    -- | Strip ticks satisfying a predicate from top of an expression,
    -- returning the remaining expression
    stripTicksTopE :: (CoreTickish -> Bool) -> Expr b -> Expr b
    stripTicksTopE :: forall b. (CoreTickish -> Bool) -> Expr b -> Expr b
    stripTicksTopE CoreTickish -> Bool
    p = Expr b -> Expr b
    go
      where go :: Expr b -> Expr b
    go (Tick CoreTickish
    t Expr b
    e) | CoreTickish -> Bool
    p CoreTickish
    t = Expr b -> Expr b
    go Expr b
    e
            go Expr b
    other            = Expr b
    other

    -- | Strip ticks satisfying a predicate from top of an expression,
    -- returning the ticks
    stripTicksTopT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish]
    stripTicksTopT :: forall b. (CoreTickish -> Bool) -> Expr b -> [CoreTickish]
    stripTicksTopT CoreTickish -> Bool
    p = [CoreTickish] -> Expr b -> [CoreTickish]
    go []
      where go :: [CoreTickish] -> Expr b -> [CoreTickish]
    go [CoreTickish]
    ts (Tick CoreTickish
    t Expr b
    e) | CoreTickish -> Bool
    p CoreTickish
    t = [CoreTickish] -> Expr b -> [CoreTickish]
    go (CoreTickish
    tCoreTickish -> [CoreTickish] -> [CoreTickish]
    forall a. a -> [a] -> [a]
    :[CoreTickish]
    ts) Expr b
    e
            go [CoreTickish]
    ts Expr b
    _                = [CoreTickish]
    ts

    -- | Completely strip ticks satisfying a predicate from an
    -- expression. Note this is O(n) in the size of the expression!
    stripTicksE :: (CoreTickish -> Bool) -> Expr b -> Expr b
    stripTicksE :: forall b. (CoreTickish -> Bool) -> Expr b -> Expr b
    stripTicksE CoreTickish -> Bool
    p Expr b
    expr = Expr b -> Expr b
    go Expr b
    expr
      where go :: Expr b -> Expr b
    go (App Expr b
    e Expr b
    a)        = Expr b -> Expr b -> Expr b
    forall b. Expr b -> Expr b -> Expr b
    App (Expr b -> Expr b
    go Expr b
    e) (Expr b -> Expr b
    go Expr b
    a)
            go (Lam b
    b Expr b
    e)        = b -> Expr b -> Expr b
    forall b. b -> Expr b -> Expr b
    Lam b
    b (Expr b -> Expr b
    go Expr b
    e)
            go (Let Bind b
    b Expr b
    e)        = Bind b -> Expr b -> Expr b
    forall b. Bind b -> Expr b -> Expr b
    Let (Bind b -> Bind b
    go_bs Bind b
    b) (Expr b -> Expr b
    go Expr b
    e)
            go (Case Expr b
    e b
    b Type
    t [Alt b]
    as)  = Expr b -> b -> Type -> [Alt b] -> Expr b
    forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case (Expr b -> Expr b
    go Expr b
    e) b
    b Type
    t ((Alt b -> Alt b) -> [Alt b] -> [Alt b]
    forall a b. (a -> b) -> [a] -> [b]
    map Alt b -> Alt b
    go_a [Alt b]
    as)
            go (Cast Expr b
    e Coercion
    c)       = Expr b -> Coercion -> Expr b
    forall b. Expr b -> Coercion -> Expr b
    Cast (Expr b -> Expr b
    go Expr b
    e) Coercion
    c
            go (Tick CoreTickish
    t Expr b
    e)
              | CoreTickish -> Bool
    p CoreTickish
    t             = Expr b -> Expr b
    go Expr b
    e
              | Bool
    otherwise       = CoreTickish -> Expr b -> Expr b
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t (Expr b -> Expr b
    go Expr b
    e)
            go Expr b
    other            = Expr b
    other
            go_bs :: Bind b -> Bind b
    go_bs (NonRec b
    b Expr b
    e)  = b -> Expr b -> Bind b
    forall b. b -> Expr b -> Bind b
    NonRec b
    b (Expr b -> Expr b
    go Expr b
    e)
            go_bs (Rec [(b, Expr b)]
    bs)      = [(b, Expr b)] -> Bind b
    forall b. [(b, Expr b)] -> Bind b
    Rec (((b, Expr b) -> (b, Expr b)) -> [(b, Expr b)] -> [(b, Expr b)]
    forall a b. (a -> b) -> [a] -> [b]
    map (b, Expr b) -> (b, Expr b)
    go_b [(b, Expr b)]
    bs)
            go_b :: (b, Expr b) -> (b, Expr b)
    go_b (b
    b, Expr b
    e)         = (b
    b, Expr b -> Expr b
    go Expr b
    e)
            go_a :: Alt b -> Alt b
    go_a (Alt AltCon
    c [b]
    bs Expr b
    e)   = AltCon -> [b] -> Expr b -> Alt b
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    c [b]
    bs (Expr b -> Expr b
    go Expr b
    e)

    stripTicksT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish]
    stripTicksT :: forall b. (CoreTickish -> Bool) -> Expr b -> [CoreTickish]
    stripTicksT CoreTickish -> Bool
    p Expr b
    expr = OrdList CoreTickish -> [CoreTickish]
    forall a. OrdList a -> [a]
    fromOL (OrdList CoreTickish -> [CoreTickish])
    -> OrdList CoreTickish -> [CoreTickish]
    forall a b. (a -> b) -> a -> b
    $ Expr b -> OrdList CoreTickish
    go Expr b
    expr
      where go :: Expr b -> OrdList CoreTickish
    go (App Expr b
    e Expr b
    a)        = Expr b -> OrdList CoreTickish
    go Expr b
    e OrdList CoreTickish -> OrdList CoreTickish -> OrdList CoreTickish
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Expr b -> OrdList CoreTickish
    go Expr b
    a
            go (Lam b
    _ Expr b
    e)        = Expr b -> OrdList CoreTickish
    go Expr b
    e
            go (Let Bind b
    b Expr b
    e)        = Bind b -> OrdList CoreTickish
    go_bs Bind b
    b OrdList CoreTickish -> OrdList CoreTickish -> OrdList CoreTickish
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` Expr b -> OrdList CoreTickish
    go Expr b
    e
            go (Case Expr b
    e b
    _ Type
    _ [Alt b]
    as)  = Expr b -> OrdList CoreTickish
    go Expr b
    e OrdList CoreTickish -> OrdList CoreTickish -> OrdList CoreTickish
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` [OrdList CoreTickish] -> OrdList CoreTickish
    forall a. [OrdList a] -> OrdList a
    concatOL ((Alt b -> OrdList CoreTickish) -> [Alt b] -> [OrdList CoreTickish]
    forall a b. (a -> b) -> [a] -> [b]
    map Alt b -> OrdList CoreTickish
    go_a [Alt b]
    as)
            go (Cast Expr b
    e Coercion
    _)       = Expr b -> OrdList CoreTickish
    go Expr b
    e
            go (Tick CoreTickish
    t Expr b
    e)
              | CoreTickish -> Bool
    p CoreTickish
    t             = CoreTickish
    t CoreTickish -> OrdList CoreTickish -> OrdList CoreTickish
    forall a. a -> OrdList a -> OrdList a
    `consOL` Expr b -> OrdList CoreTickish
    go Expr b
    e
              | Bool
    otherwise       = Expr b -> OrdList CoreTickish
    go Expr b
    e
            go Expr b
    _                = OrdList CoreTickish
    forall a. OrdList a
    nilOL
            go_bs :: Bind b -> OrdList CoreTickish
    go_bs (NonRec b
    _ Expr b
    e)  = Expr b -> OrdList CoreTickish
    go Expr b
    e
            go_bs (Rec [(b, Expr b)]
    bs)      = [OrdList CoreTickish] -> OrdList CoreTickish
    forall a. [OrdList a] -> OrdList a
    concatOL (((b, Expr b) -> OrdList CoreTickish)
    -> [(b, Expr b)] -> [OrdList CoreTickish]
    forall a b. (a -> b) -> [a] -> [b]
    map (b, Expr b) -> OrdList CoreTickish
    go_b [(b, Expr b)]
    bs)
            go_b :: (b, Expr b) -> OrdList CoreTickish
    go_b (b
    _, Expr b
    e)         = Expr b -> OrdList CoreTickish
    go Expr b
    e
            go_a :: Alt b -> OrdList CoreTickish
    go_a (Alt AltCon
    _ [b]
    _ Expr b
    e)    = Expr b -> OrdList CoreTickish
    go Expr b
    e

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Other expression construction}
    *                                                                      *
    ************************************************************************
    -}

    bindNonRec :: HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr
    -- ^ @bindNonRec x r b@ produces either:
    --
    -- > let x = r in b
    --
    -- or:
    --
    -- > case r of x { _DEFAULT_ -> b }
    --
    -- depending on whether we have to use a @case@ or @let@
    -- binding for the expression (see 'needsCaseBinding').
    -- It's used by the desugarer to avoid building bindings
    -- that give Core Lint a heart attack, although actually
    -- the simplifier deals with them perfectly well. See
    -- also 'GHC.Core.Make.mkCoreLet'
    bindNonRec :: HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    bndr CoreExpr
    rhs CoreExpr
    body
      | Id -> Bool
    isTyVar Id
    bndr                       = CoreExpr
    let_bind
      | Id -> Bool
    isCoVar Id
    bndr                       = if CoreExpr -> Bool
    forall b. Expr b -> Bool
    isCoArg CoreExpr
    rhs then CoreExpr
    let_bind
        {- See Note [Binding coercions] -}                  else CoreExpr
    case_bind
      | Id -> Bool
    isJoinId Id
    bndr                      = CoreExpr
    let_bind
      | HasDebugCallStack => Type -> CoreExpr -> Bool
    Type -> CoreExpr -> Bool
    needsCaseBinding (Id -> Type
    idType Id
    bndr) CoreExpr
    rhs = CoreExpr
    case_bind
      | Bool
    otherwise                          = CoreExpr
    let_bind
      where
        case_bind :: CoreExpr
    case_bind = CoreExpr -> Id -> CoreExpr -> CoreExpr
    mkDefaultCase CoreExpr
    rhs Id
    bndr CoreExpr
    body
        let_bind :: CoreExpr
    let_bind  = Bind Id -> CoreExpr -> CoreExpr
    forall b. Bind b -> Expr b -> Expr b
    Let (Id -> CoreExpr -> Bind Id
    forall b. b -> Expr b -> Bind b
    NonRec Id
    bndr CoreExpr
    rhs) CoreExpr
    body

    -- | `needsCaseBinding` tests whether we have to use a @case@ rather than @let@
    -- binding for this expression as per the invariants of 'CoreExpr': see
    -- "GHC.Core#let_can_float_invariant"
    -- (needsCaseBinding ty rhs) requires that `ty` has a well-defined levity, else
    -- `typeLevity ty` will fail; but that should be the case because
    -- `needsCaseBinding` is only called once typechecking is complete
    needsCaseBinding :: HasDebugCallStack => Type -> CoreExpr -> Bool
    needsCaseBinding :: HasDebugCallStack => Type -> CoreExpr -> Bool
    needsCaseBinding Type
    ty CoreExpr
    rhs = Levity -> CoreExpr -> Bool
    needsCaseBindingL (HasDebugCallStack => Type -> Levity
    Type -> Levity
    typeLevity Type
    ty) CoreExpr
    rhs

    needsCaseBindingL :: Levity -> CoreExpr -> Bool
    -- True <=> make a case expression instead of a let
    -- These can arise either from the desugarer,
    -- or from beta reductions: (\x.e) (x +# y)
    needsCaseBindingL :: Levity -> CoreExpr -> Bool
    needsCaseBindingL Levity
    Lifted   CoreExpr
    _rhs = Bool
    False
    needsCaseBindingL Levity
    Unlifted CoreExpr
    rhs = Bool -> Bool
    not (CoreExpr -> Bool
    exprOkForSpeculation CoreExpr
    rhs)

    mkAltExpr :: AltCon     -- ^ Case alternative constructor
              -> [CoreBndr] -- ^ Things bound by the pattern match
              -> [Type]     -- ^ The type arguments to the case alternative
              -> CoreExpr
    -- ^ This guy constructs the value that the scrutinee must have
    -- given that you are in one particular branch of a case
    mkAltExpr :: AltCon -> [Id] -> [Type] -> CoreExpr
    mkAltExpr (DataAlt DataCon
    con) [Id]
    args [Type]
    inst_tys
      = DataCon -> [CoreExpr] -> CoreExpr
    forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    con ((Type -> CoreExpr) -> [Type] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> CoreExpr
    forall b. Type -> Expr b
    Type [Type]
    inst_tys [CoreExpr] -> [CoreExpr] -> [CoreExpr]
    forall a. [a] -> [a] -> [a]
    ++ [Id] -> [CoreExpr]
    forall b. [Id] -> [Expr b]
    varsToCoreExprs [Id]
    args)
    mkAltExpr (LitAlt Literal
    lit) [] []
      = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit Literal
    lit
    mkAltExpr (LitAlt Literal
    _) [Id]
    _ [Type]
    _ = String -> CoreExpr
    forall a. HasCallStack => String -> a
    panic String
    "mkAltExpr LitAlt"
    mkAltExpr AltCon
    DEFAULT [Id]
    _ [Type]
    _ = String -> CoreExpr
    forall a. HasCallStack => String -> a
    panic String
    "mkAltExpr DEFAULT"

    mkDefaultCase :: CoreExpr -> Id -> CoreExpr -> CoreExpr
    -- Make (case x of y { DEFAULT -> e }
    mkDefaultCase :: CoreExpr -> Id -> CoreExpr -> CoreExpr
    mkDefaultCase CoreExpr
    scrut Id
    case_bndr CoreExpr
    body
      = CoreExpr -> Id -> Type -> [Alt Id] -> CoreExpr
    forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    scrut Id
    case_bndr (HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    body) [AltCon -> [Id] -> CoreExpr -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] CoreExpr
    body]

    mkSingleAltCase :: CoreExpr -> Id -> AltCon -> [Var] -> CoreExpr -> CoreExpr
    -- Use this function if possible, when building a case,
    -- because it ensures that the type on the Case itself
    -- doesn't mention variables bound by the case
    -- See Note [Care with the type of a case expression]
    mkSingleAltCase :: CoreExpr -> Id -> AltCon -> [Id] -> CoreExpr -> CoreExpr
    mkSingleAltCase CoreExpr
    scrut Id
    case_bndr AltCon
    con [Id]
    bndrs CoreExpr
    body
      = CoreExpr -> Id -> Type -> [Alt Id] -> CoreExpr
    forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    scrut Id
    case_bndr Type
    case_ty [AltCon -> [Id] -> CoreExpr -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [Id]
    bndrs CoreExpr
    body]
      where
        body_ty :: Type
    body_ty = HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    body

        case_ty :: Type
    case_ty -- See Note [Care with the type of a case expression]
          | Just Type
    body_ty' <- [Id] -> Type -> Maybe Type
    occCheckExpand [Id]
    bndrs Type
    body_ty
          = Type
    body_ty'

          | Bool
    otherwise
          = String -> SDoc -> Type
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "mkSingleAltCase" (CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    scrut SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    bndrs SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    body_ty)

    {- Note [Care with the type of a case expression]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider a phantom type synonym
       type S a = Int
    and we want to form the case expression
       case x of K (a::*) -> (e :: S a)

    We must not make the type field of the case-expression (S a) because
    'a' isn't in scope.  Hence the call to occCheckExpand.  This caused
    issue #17056.

    NB: this situation can only arise with type synonyms, which can
    falsely "mention" type variables that aren't "really there", and which
    can be eliminated by expanding the synonym.

    Note [Binding coercions]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    Consider binding a CoVar, c = e.  Then, we must satisfy
    Note [Core type and coercion invariant] in GHC.Core,
    which allows only (Coercion co) on the RHS.

    ************************************************************************
    *                                                                      *
                   Operations over case alternatives
    *                                                                      *
    ************************************************************************

    The default alternative must be first, if it exists at all.
    This makes it easy to find, though it makes matching marginally harder.
    -}

    -- | Extract the default case alternative
    findDefault :: [Alt b] -> ([Alt b], Maybe (Expr b))
    findDefault :: forall b. [Alt b] -> ([Alt b], Maybe (Expr b))
    findDefault (Alt AltCon
    DEFAULT [b]
    args Expr b
    rhs : [Alt b]
    alts) = Bool -> ([Alt b], Maybe (Expr b)) -> ([Alt b], Maybe (Expr b))
    forall a. HasCallStack => Bool -> a -> a
    assert ([b] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [b]
    args) ([Alt b]
    alts, Expr b -> Maybe (Expr b)
    forall a. a -> Maybe a
    Just Expr b
    rhs)
    findDefault [Alt b]
    alts                          =                    ([Alt b]
    alts, Maybe (Expr b)
    forall a. Maybe a
    Nothing)

    addDefault :: [Alt b] -> Maybe (Expr b) -> [Alt b]
    addDefault :: forall b. [Alt b] -> Maybe (Expr b) -> [Alt b]
    addDefault [Alt b]
    alts Maybe (Expr b)
    Nothing    = [Alt b]
    alts
    addDefault [Alt b]
    alts (Just Expr b
    rhs) = AltCon -> [b] -> Expr b -> Alt b
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] Expr b
    rhs Alt b -> [Alt b] -> [Alt b]
    forall a. a -> [a] -> [a]
    : [Alt b]
    alts

    isDefaultAlt :: Alt b -> Bool
    isDefaultAlt :: forall b. Alt b -> Bool
    isDefaultAlt (Alt AltCon
    DEFAULT [b]
    _ Expr b
    _) = Bool
    True
    isDefaultAlt Alt b
    _                 = Bool
    False

    -- | Find the case alternative corresponding to a particular
    -- constructor: panics if no such constructor exists
    findAlt :: AltCon -> [Alt b] -> Maybe (Alt b)
        -- A "Nothing" result *is* legitimate
        -- See Note [Unreachable code]
    findAlt :: forall b. AltCon -> [Alt b] -> Maybe (Alt b)
    findAlt AltCon
    con [Alt b]
    alts
      = case [Alt b]
    alts of
            (deflt :: Alt b
    deflt@(Alt AltCon
    DEFAULT [b]
    _ Expr b
    _):[Alt b]
    alts) -> [Alt b] -> Maybe (Alt b) -> Maybe (Alt b)
    go [Alt b]
    alts (Alt b -> Maybe (Alt b)
    forall a. a -> Maybe a
    Just Alt b
    deflt)
            [Alt b]
    _                              -> [Alt b] -> Maybe (Alt b) -> Maybe (Alt b)
    go [Alt b]
    alts Maybe (Alt b)
    forall a. Maybe a
    Nothing
      where
        go :: [Alt b] -> Maybe (Alt b) -> Maybe (Alt b)
    go []                     Maybe (Alt b)
    deflt = Maybe (Alt b)
    deflt
        go (alt :: Alt b
    alt@(Alt AltCon
    con1 [b]
    _ Expr b
    _) : [Alt b]
    alts) Maybe (Alt b)
    deflt
          = case AltCon
    con AltCon -> AltCon -> Ordering
    `cmpAltCon` AltCon
    con1 of
              Ordering
    LT -> Maybe (Alt b)
    deflt   -- Missed it already; the alts are in increasing order
              Ordering
    EQ -> Alt b -> Maybe (Alt b)
    forall a. a -> Maybe a
    Just Alt b
    alt
              Ordering
    GT -> Bool -> Maybe (Alt b) -> Maybe (Alt b)
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (AltCon
    con1 AltCon -> AltCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == AltCon
    DEFAULT)) (Maybe (Alt b) -> Maybe (Alt b)) -> Maybe (Alt b) -> Maybe (Alt b)
    forall a b. (a -> b) -> a -> b
    $ [Alt b] -> Maybe (Alt b) -> Maybe (Alt b)
    go [Alt b]
    alts Maybe (Alt b)
    deflt

    {- Note [Unreachable code]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    It is possible (although unusual) for GHC to find a case expression
    that cannot match.  For example:

         data Col = Red | Green | Blue
         x = Red
         f v = case x of
                  Red -> ...
                  _ -> ...(case x of { Green -> e1; Blue -> e2 })...

    Suppose that for some silly reason, x isn't substituted in the case
    expression.  (Perhaps there's a NOINLINE on it, or profiling SCC stuff
    gets in the way; cf #3118.)  Then the full-laziness pass might produce
    this

         x = Red
         lvl = case x of { Green -> e1; Blue -> e2 })
         f v = case x of
                 Red -> ...
                 _ -> ...lvl...

    Now if x gets inlined, we won't be able to find a matching alternative
    for 'Red'.  That's because 'lvl' is unreachable.  So rather than crashing
    we generate (error "Inaccessible alternative").

    Similar things can happen (augmented by GADTs) when the Simplifier
    filters down the matching alternatives in GHC.Core.Opt.Simplify.rebuildCase.
    -}

    ---------------------------------
    mergeCaseAlts :: Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt])
    -- See Note [Merge Nested Cases]
    mergeCaseAlts :: Id -> [Alt Id] -> Maybe ([Bind Id], [Alt Id])
    mergeCaseAlts Id
    outer_bndr (Alt AltCon
    DEFAULT [Id]
    _ CoreExpr
    deflt_rhs : [Alt Id]
    outer_alts)
      | Just ([Bind Id]
    joins, [Alt Id]
    inner_alts) <- CoreExpr -> Maybe ([Bind Id], [Alt Id])
    go CoreExpr
    deflt_rhs
      = ([Bind Id], [Alt Id]) -> Maybe ([Bind Id], [Alt Id])
    forall a. a -> Maybe a
    Just ([Bind Id]
    joins, [Alt Id] -> [Alt Id] -> [Alt Id]
    forall a. [Alt a] -> [Alt a] -> [Alt a]
    mergeAlts [Alt Id]
    outer_alts [Alt Id]
    inner_alts)
                    -- NB: mergeAlts gives priority to the left
                    --      case x of
                    --        A -> e1
                    --        DEFAULT -> case x of
                    --                      A -> e2
                    --                      B -> e3
                    -- When we merge, we must ensure that e1 takes
                    -- precedence over e2 as the value for A!
      where
        go :: CoreExpr -> Maybe ([CoreBind], [CoreAlt])

        -- Whizzo: we can merge!
        go :: CoreExpr -> Maybe ([Bind Id], [Alt Id])
    go (Case (Var Id
    inner_scrut_var) Id
    inner_bndr Type
    _ [Alt Id]
    inner_alts)
           | Id
    inner_scrut_var Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    outer_bndr
           , Bool -> Bool
    not (Id
    inner_bndr Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    outer_bndr)   -- Avoid shadowing
           , let wrap_let :: CoreExpr -> CoreExpr
    wrap_let CoreExpr
    rhs' = Bind Id -> CoreExpr -> CoreExpr
    forall b. Bind b -> Expr b -> Expr b
    Let (Id -> CoreExpr -> Bind Id
    forall b. b -> Expr b -> Bind b
    NonRec Id
    inner_bndr (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    outer_bndr)) CoreExpr
    rhs'
                    -- inner_bndr is never dead!  It's the scrutinee!
                    -- The let is OK even for unboxed binders
                    -- See Note [Merge Nested Cases] wrinkle (MC2)
                 do_one :: Alt Id -> Maybe (Alt Id)
    do_one (Alt AltCon
    con [Id]
    bndrs CoreExpr
    rhs)
                   | (Id -> Bool) -> [Id] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    outer_bndr) [Id]
    bndrs = Maybe (Alt Id)
    forall a. Maybe a
    Nothing
                   | Bool
    otherwise                 = Alt Id -> Maybe (Alt Id)
    forall a. a -> Maybe a
    Just (AltCon -> [Id] -> CoreExpr -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [Id]
    bndrs (CoreExpr -> CoreExpr
    wrap_let CoreExpr
    rhs))
           = do { alts' <- (Alt Id -> Maybe (Alt Id)) -> [Alt Id] -> Maybe [Alt Id]
    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 Alt Id -> Maybe (Alt Id)
    do_one [Alt Id]
    inner_alts
                ; return ([], alts') }

        -- Deal with tagToEnum# See Note [Merge Nested Cases] wrinkle (MC3)
        go (App (App (Var Id
    f) (Type Type
    type_arg)) (Var Id
    v))
          | Id
    v Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    outer_bndr
          , Just PrimOp
    TagToEnumOp <- Id -> Maybe PrimOp
    isPrimOpId_maybe Id
    f
          , Just TyCon
    tc  <- Type -> Maybe TyCon
    tyConAppTyCon_maybe Type
    type_arg
          , Just (DataCon
    dc1:[DataCon]
    dcs) <- TyCon -> Maybe [DataCon]
    tyConDataCons_maybe TyCon
    tc   -- At least one data constructor
          , [DataCon]
    dcs [DataCon] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthAtMost` Int
    3  -- Arbitrary
          = ([Bind Id], [Alt Id]) -> Maybe ([Bind Id], [Alt Id])
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [], DataCon -> [DataCon] -> [Alt Id]
    forall {b}. DataCon -> [DataCon] -> [Alt b]
    mk_alts DataCon
    dc1 [DataCon]
    dcs)
          where
            mk_lit :: DataCon -> Literal
    mk_lit DataCon
    dc = Integer -> Literal
    mkLitIntUnchecked (Integer -> Literal) -> Integer -> Literal
    forall a b. (a -> b) -> a -> b
    $ Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ DataCon -> Int
    dataConTagZ DataCon
    dc
            mk_rhs :: DataCon -> Expr b
    mk_rhs DataCon
    dc = Id -> Expr b
    forall b. Id -> Expr b
    Var (DataCon -> Id
    dataConWorkId DataCon
    dc)
            mk_alts :: DataCon -> [DataCon] -> [Alt b]
    mk_alts DataCon
    dc1 [DataCon]
    dcs =  AltCon -> [b] -> Expr b -> Alt b
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT              [] (DataCon -> Expr b
    forall {b}. DataCon -> Expr b
    mk_rhs DataCon
    dc1)
                            Alt b -> [Alt b] -> [Alt b]
    forall a. a -> [a] -> [a]
    : [AltCon -> [b] -> Expr b -> Alt b
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (Literal -> AltCon
    LitAlt (DataCon -> Literal
    mk_lit DataCon
    dc)) [] (DataCon -> Expr b
    forall {b}. DataCon -> Expr b
    mk_rhs DataCon
    dc) | DataCon
    dc <- [DataCon]
    dcs]

        -- Float out let/join bindings
        -- See Note [Merge Nested Cases] wrinkle (MC4)
        go (Let Bind Id
    bind CoreExpr
    body)
          | [Alt Id] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Id]
    outer_alts Bool -> Bool -> Bool
    || Bind Id -> Bool
    isJoinBind Bind Id
    bind
          = do { (joins, alts) <- CoreExpr -> Maybe ([Bind Id], [Alt Id])
    go CoreExpr
    body

                 -- Check for capture; but only if we could otherwise do a merge
               ; let capture = Id
    outer_bndr Id -> [Id] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Bind Id -> [Id]
    forall b. Bind b -> [b]
    bindersOf Bind Id
    bind
                               Bool -> Bool -> Bool
    || Id
    outer_bndr Id -> VarSet -> Bool
    `elemVarSet` Bind Id -> VarSet
    bindFreeVars Bind Id
    bind
               ; guard (not capture)

               ; return (bind:joins, alts ) }
          | Bool
    otherwise
          = Maybe ([Bind Id], [Alt Id])
    forall a. Maybe a
    Nothing

        -- We don't want ticks to get in the way; just push them inwards.
        -- (This happens when you add SourceTicks e.g. GHC.Num.Integer.integerLt#)
        go (Tick CoreTickish
    t CoreExpr
    body)
          = do { (joins, alts) <- CoreExpr -> Maybe ([Bind Id], [Alt Id])
    go CoreExpr
    body
               ; return (joins, [Alt con bs (Tick t rhs) | Alt con bs rhs <- alts]) }

        go CoreExpr
    _ = Maybe ([Bind Id], [Alt Id])
    forall a. Maybe a
    Nothing

    mergeCaseAlts Id
    _ [Alt Id]
    _ = Maybe ([Bind Id], [Alt Id])
    forall a. Maybe a
    Nothing

    ---------------------------------
    mergeAlts :: [Alt a] -> [Alt a] -> [Alt a]
    -- ^ Merge alternatives preserving order; alternatives in
    -- the first argument shadow ones in the second
    mergeAlts :: forall a. [Alt a] -> [Alt a] -> [Alt a]
    mergeAlts [] [Alt a]
    as2 = [Alt a]
    as2
    mergeAlts [Alt a]
    as1 [] = [Alt a]
    as1
    mergeAlts (Alt a
    a1:[Alt a]
    as1) (Alt a
    a2:[Alt a]
    as2)
      = case Alt a
    a1 Alt a -> Alt a -> Ordering
    forall a. Alt a -> Alt a -> Ordering
    `cmpAlt` Alt a
    a2 of
            Ordering
    LT -> Alt a
    a1 Alt a -> [Alt a] -> [Alt a]
    forall a. a -> [a] -> [a]
    : [Alt a] -> [Alt a] -> [Alt a]
    forall a. [Alt a] -> [Alt a] -> [Alt a]
    mergeAlts [Alt a]
    as1      (Alt a
    a2Alt a -> [Alt a] -> [Alt a]
    forall a. a -> [a] -> [a]
    :[Alt a]
    as2)
            Ordering
    EQ -> Alt a
    a1 Alt a -> [Alt a] -> [Alt a]
    forall a. a -> [a] -> [a]
    : [Alt a] -> [Alt a] -> [Alt a]
    forall a. [Alt a] -> [Alt a] -> [Alt a]
    mergeAlts [Alt a]
    as1      [Alt a]
    as2       -- Discard a2
            Ordering
    GT -> Alt a
    a2 Alt a -> [Alt a] -> [Alt a]
    forall a. a -> [a] -> [a]
    : [Alt a] -> [Alt a] -> [Alt a]
    forall a. [Alt a] -> [Alt a] -> [Alt a]
    mergeAlts (Alt a
    a1Alt a -> [Alt a] -> [Alt a]
    forall a. a -> [a] -> [a]
    :[Alt a]
    as1) [Alt a]
    as2

    ---------------------------------
    trimConArgs :: AltCon -> [CoreArg] -> [CoreArg]
    -- ^ Given:
    --
    -- > case (C a b x y) of
    -- >        C b x y -> ...
    --
    -- We want to drop the leading type argument of the scrutinee
    -- leaving the arguments to match against the pattern

    trimConArgs :: AltCon -> [CoreExpr] -> [CoreExpr]
    trimConArgs AltCon
    DEFAULT      [CoreExpr]
    args = Bool -> [CoreExpr] -> [CoreExpr]
    forall a. HasCallStack => Bool -> a -> a
    assert ([CoreExpr] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreExpr]
    args) []
    trimConArgs (LitAlt Literal
    _)   [CoreExpr]
    args = Bool -> [CoreExpr] -> [CoreExpr]
    forall a. HasCallStack => Bool -> a -> a
    assert ([CoreExpr] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreExpr]
    args) []
    trimConArgs (DataAlt DataCon
    dc) [CoreExpr]
    args = [Id] -> [CoreExpr] -> [CoreExpr]
    forall b a. [b] -> [a] -> [a]
    dropList (DataCon -> [Id]
    dataConUnivTyVars DataCon
    dc) [CoreExpr]
    args

    filterAlts :: TyCon                -- ^ Type constructor of scrutinee's type (used to prune possibilities)
               -> [Type]               -- ^ And its type arguments
               -> [AltCon]             -- ^ 'imposs_cons': constructors known to be impossible due to the form of the scrutinee
               -> [Alt b] -- ^ Alternatives
               -> ([AltCon], [Alt b])
                 -- Returns:
                 --  1. Constructors that will never be encountered by the
                 --     *default* case (if any).  A superset of imposs_cons
                 --  2. The new alternatives, trimmed by
                 --        a) remove imposs_cons
                 --        b) remove constructors which can't match because of GADTs
                 --
                 -- NB: the final list of alternatives may be empty:
                 -- This is a tricky corner case.  If the data type has no constructors,
                 -- which GHC allows, or if the imposs_cons covers all constructors (after taking
                 -- account of GADTs), then no alternatives can match.
                 --
                 -- If callers need to preserve the invariant that there is always at least one branch
                 -- in a "case" statement then they will need to manually add a dummy case branch that just
                 -- calls "error" or similar.
    filterAlts :: forall b.
    TyCon -> [Type] -> [AltCon] -> [Alt b] -> ([AltCon], [Alt b])
    filterAlts TyCon
    _tycon [Type]
    inst_tys [AltCon]
    imposs_cons [Alt b]
    alts
      = [AltCon]
    imposs_deflt_cons [AltCon] -> ([AltCon], [Alt b]) -> ([AltCon], [Alt b])
    forall a b. [a] -> b -> b
    `seqList`
          ([AltCon]
    imposs_deflt_cons, [Alt b] -> Maybe (Expr b) -> [Alt b]
    forall b. [Alt b] -> Maybe (Expr b) -> [Alt b]
    addDefault [Alt b]
    trimmed_alts Maybe (Expr b)
    maybe_deflt)
      -- Very important to force `imposs_deflt_cons` as that forces `alt_cons`, which
      -- is essentially as retaining `alts_wo_default` or any `Alt b` for that matter
      -- leads to a huge space leak (see #22102 and !8896)
      where
        ([Alt b]
    alts_wo_default, Maybe (Expr b)
    maybe_deflt) = [Alt b] -> ([Alt b], Maybe (Expr b))
    forall b. [Alt b] -> ([Alt b], Maybe (Expr b))
    findDefault [Alt b]
    alts
        alt_cons :: [AltCon]
    alt_cons = [AltCon
    con | Alt AltCon
    con [b]
    _ Expr b
    _ <- [Alt b]
    alts_wo_default]

        trimmed_alts :: [Alt b]
    trimmed_alts = (Alt b -> Bool) -> [Alt b] -> [Alt b]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut ([Type] -> Alt b -> Bool
    forall b. [Type] -> Alt b -> Bool
    impossible_alt [Type]
    inst_tys) [Alt b]
    alts_wo_default

        imposs_cons_set :: Set AltCon
    imposs_cons_set = [AltCon] -> Set AltCon
    forall a. Ord a => [a] -> Set a
    Set.fromList [AltCon]
    imposs_cons
        imposs_deflt_cons :: [AltCon]
    imposs_deflt_cons =
          [AltCon]
    imposs_cons [AltCon] -> [AltCon] -> [AltCon]
    forall a. [a] -> [a] -> [a]
    ++ (AltCon -> Bool) -> [AltCon] -> [AltCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (AltCon -> Set AltCon -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set AltCon
    imposs_cons_set) [AltCon]
    alt_cons
             -- "imposs_deflt_cons" are handled
             --   EITHER by the context,
             --   OR by a non-DEFAULT branch in this case expression.

        impossible_alt :: [Type] -> Alt b -> Bool
        impossible_alt :: forall b. [Type] -> Alt b -> Bool
    impossible_alt [Type]
    _ (Alt AltCon
    con [b]
    _ Expr b
    _) | AltCon
    con AltCon -> Set AltCon -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set AltCon
    imposs_cons_set = Bool
    True
        impossible_alt [Type]
    inst_tys (Alt (DataAlt DataCon
    con) [b]
    _ Expr b
    _) = [Type] -> DataCon -> Bool
    dataConCannotMatch [Type]
    inst_tys DataCon
    con
        impossible_alt [Type]
    _  Alt b
    _                             = Bool
    False

    -- | Refine the default alternative to a 'DataAlt', if there is a unique way to do so.
    -- See Note [Refine DEFAULT case alternatives]
    refineDefaultAlt :: [Unique]          -- ^ Uniques for constructing new binders
                     -> Mult              -- ^ Multiplicity annotation of the case expression
                     -> TyCon             -- ^ Type constructor of scrutinee's type
                     -> [Type]            -- ^ Type arguments of scrutinee's type
                     -> [AltCon]          -- ^ Constructors that cannot match the DEFAULT (if any)
                     -> [CoreAlt]
                     -> (Bool, [CoreAlt]) -- ^ 'True', if a default alt was replaced with a 'DataAlt'
    refineDefaultAlt :: [Unique]
    -> Type
    -> TyCon
    -> [Type]
    -> [AltCon]
    -> [Alt Id]
    -> (Bool, [Alt Id])
    refineDefaultAlt [Unique]
    us Type
    mult TyCon
    tycon [Type]
    tys [AltCon]
    imposs_deflt_cons [Alt Id]
    all_alts
      | Alt AltCon
    DEFAULT [Id]
    _ CoreExpr
    rhs : [Alt Id]
    rest_alts <- [Alt Id]
    all_alts
      , TyCon -> Bool
    isAlgTyCon TyCon
    tycon            -- It's a data type, tuple, or unboxed tuples.
      , Bool -> Bool
    not (TyCon -> Bool
    isNewTyCon TyCon
    tycon)      -- Exception 1 in Note [Refine DEFAULT case alternatives]
      , Bool -> Bool
    not (TyCon -> Bool
    isTypeDataTyCon TyCon
    tycon) -- Exception 2 in Note [Refine DEFAULT case alternatives]
      , Just [DataCon]
    all_cons <- TyCon -> Maybe [DataCon]
    tyConDataCons_maybe TyCon
    tycon
      , let imposs_data_cons :: UniqSet DataCon
    imposs_data_cons = [DataCon] -> UniqSet DataCon
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet [DataCon
    con | DataAlt DataCon
    con <- [AltCon]
    imposs_deflt_cons]
                                 -- We now know it's a data type, so we can use
                                 -- UniqSet rather than Set (more efficient)
            impossible :: DataCon -> Bool
    impossible DataCon
    con   = DataCon
    con DataCon -> UniqSet DataCon -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    `elementOfUniqSet` UniqSet DataCon
    imposs_data_cons
                                 Bool -> Bool -> Bool
    || [Type] -> DataCon -> Bool
    dataConCannotMatch [Type]
    tys DataCon
    con
      = case (DataCon -> Bool) -> [DataCon] -> [DataCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut DataCon -> Bool
    impossible [DataCon]
    all_cons of
           -- Eliminate the default alternative
           -- altogether if it can't match:
           []    -> (Bool
    False, [Alt Id]
    rest_alts)

           -- It matches exactly one constructor, so fill it in:
           [DataCon
    con] -> (Bool
    True, [Alt Id] -> [Alt Id] -> [Alt Id]
    forall a. [Alt a] -> [Alt a] -> [Alt a]
    mergeAlts [Alt Id]
    rest_alts [AltCon -> [Id] -> CoreExpr -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt DataCon
    con) ([Id]
    ex_tvs [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id]
    arg_ids) CoreExpr
    rhs])
                           -- We need the mergeAlts to keep the alternatives in the right order
                 where
                    ([Id]
    ex_tvs, [Id]
    arg_ids) = [Unique] -> Type -> DataCon -> [Type] -> ([Id], [Id])
    dataConRepInstPat [Unique]
    us Type
    mult DataCon
    con [Type]
    tys

           -- It matches more than one, so do nothing
           [DataCon]
    _  -> (Bool
    False, [Alt Id]
    all_alts)

      | Bool
    debugIsOn, TyCon -> Bool
    isAlgTyCon TyCon
    tycon, [DataCon] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (TyCon -> [DataCon]
    tyConDataCons TyCon
    tycon)
      , Bool -> Bool
    not (TyCon -> Bool
    isFamilyTyCon TyCon
    tycon Bool -> Bool -> Bool
    || TyCon -> Bool
    isAbstractTyCon TyCon
    tycon)
            -- Check for no data constructors
            -- This can legitimately happen for abstract types and type families,
            -- so don't report that
      = (Bool
    False, [Alt Id]
    all_alts)

      | Bool
    otherwise      -- The common case
      = (Bool
    False, [Alt Id]
    all_alts)

    {- Note [Merge Nested Cases]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
           case e of b {             ==>   case e of b {
             p1 -> rhs1                      p1 -> rhs1
             ...                             ...
             pm -> rhsm                      pm -> rhsm
             _  -> case b of b' {            pn -> let b'=b in rhsn
                         pn -> rhsn          ...
                         ...                 po -> let b'=b in rhso
                         po -> rhso          _  -> let b'=b in rhsd
                         _  -> rhsd
           }

    which merges two cases in one case when -- the default alternative of
    the outer case scrutinises the same variable as the outer case. This
    transformation is called Case Merging.  It avoids that the same
    variable is scrutinised multiple times.

    Wrinkles

    (MC1) Historical note. I tried making `mergeCaseAlts` "looks though" an inner
         single-alternative case-on-variable. For example
           case x of {
              ...outer-alts...
              DEFAULT -> case y of (a,b) ->
                         case x of { A -> rhs1; B -> rhs2 }
        ===>
           case x of
             ...outer-alts...
             a -> case y of (a,b) -> rhs1
             B -> case y of (a,b) -> rhs2

        This duplicates the `case y` but it removes the case x; so it is a win
        in terms of execution time (combining the cases on x) at the cost of
        perhaps duplicating the `case y`.  A case in point is integerEq, which
        is defined thus
            integerEq :: Integer -> Integer -> Bool
            integerEq !x !y = isTrue# (integerEq# x y)
        which becomes
            integerEq
              = \ (x :: Integer) (y_aAL :: Integer) ->
                  case x of x1 { __DEFAULT ->
                  case y of y1 { __DEFAULT ->
                  case x1 of {
                    IS x2 -> case y1 of {
                               __DEFAULT -> GHC.Types.False;
                               IS y2     -> tagToEnum# @Bool (==# x2 y2) };
                    IP x2 -> ...
                    IN x2 -> ...
        We want to merge the outer `case x` with the inner `case x1`.

        But (a) this is all a bit dubious: see #24251, and
            (b) it is hard to combine with (MC4)
        So I'm not doing this any more.  If we want to do it, we'll handle it
        separately: #24251.

        End of historical note

    (MC2) The auxiliary bindings b'=b are annoying, because they force another
          simplifier pass, but there seems no easy way to avoid them.  See
          Note [Which transformations are innocuous] in GHC.Core.Opt.Stats.

    (MC3) Consider
             case f x of (r::Int#) -> tagToEnum# r :: Bool
          `mergeCaseAlts` as a special case to treat this as if it was
             case f x of r ->
               case r of { 0# -> False; 1# -> True }
          which can be merged to
             case f x of { 0# -> False; 1# -> True }

          To see why this is important, return to
             case f x of (r::Int#) -> tagToEnum# r :: Bool
          and supppose `f` inlines to a case expression.  Then then we get
             let $j r = tagToEnum# r
             case .. of { .. jump $j 0#; ...jump $j 1# ... }
          Now if the entire expression is consumed by another case-expression,
          that outer case will only see (tagToEnum# r) which it can't do much
          with.  Whereas the result of the above case-merge generates much better
          code: no branching on Int#

    (MC4) Consider
              case f x of r ->
                join $j y = <rhs> in
                case r of { ...alts ... }
          This is pretty common, and it a pity for it to defeat the case-merge
          transformation; and it makes the optimiser fragile to inlining decisions
          for join points.

          So `mergeCaseAlts` floats out any join points. It doesn't float out
          non-join-points unless the /outer/ case has just one alternative; doing
          so would risk more allocation

    (MC5) See Note [Cascading case merge]

    See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils

    Note [Cascading case merge]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Case merging should cascade in one sweep, because the Simplifier tries it /after/
    simplifying (and hence case-merging) the inner case.  For example

          case e of a {
            DEFAULT -> case a of b
                          DEFAULT -> case b of c {
                                         DEFAULT -> e
                                         A -> ea
                          B -> eb
            C -> ec
    ==> {simplify inner case}
          case e of a {
            DEFAULT -> case a of b
                          DEFAULT -> let c = b in e
                          A -> let c = b in ea
                          B -> eb
            C -> ec
    ==> {case-merge on outer case}
          case e of a {
            DEFAULT -> let b = a in let c = b in e
            A -> let b = a in let c = b in ea
            B -> let b = a in eb
            C -> ec

    However here's a tricky case that we still don't catch, and I don't
    see how to catch it in one pass:

      case x of c1 { I# a1 ->
      case a1 of c2 ->
        0 -> ...
        DEFAULT -> case x of c3 { I# a2 ->
                   case a2 of ...

    After occurrence analysis (and its binder-swap) we get this

      case x of c1 { I# a1 ->
      let x = c1 in         -- Binder-swap addition
      case a1 of c2 ->
        0 -> ...
        DEFAULT -> case x of c3 { I# a2 ->
                   case a2 of ...

    When we simplify the inner case x, we'll see that
    x=c1=I# a1.  So we'll bind a2 to a1, and get

      case x of c1 { I# a1 ->
      case a1 of c2 ->
        0 -> ...
        DEFAULT -> case a1 of ...

    This is correct, but we can't do a case merge in this sweep
    because c2 /= a1.  Reason: the binding c1=I# a1 went inwards
    without getting changed to c1=I# c2.

    I don't think this is worth fixing, even if I knew how. It'll
    all come out in the next pass anyway.

    Note [Refine DEFAULT case alternatives]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    refineDefaultAlt replaces the DEFAULT alt with a constructor if there
    is one possible value it could be.

    The simplest example being
        foo :: () -> ()
        foo x = case x of !_ -> ()
    which rewrites to
        foo :: () -> ()
        foo x = case x of () -> ()

    There are two reasons in general why replacing a DEFAULT alternative
    with a specific constructor is desirable.

    1. We can simplify inner expressions.  For example

           data Foo = Foo1 ()

           test :: Foo -> ()
           test x = case x of
                      DEFAULT -> mid (case x of
                                        Foo1 x1 -> x1)

       refineDefaultAlt fills in the DEFAULT here with `Foo ip1` and then
       x becomes bound to `Foo ip1` so is inlined into the other case
       which causes the KnownBranch optimisation to kick in. If we don't
       refine DEFAULT to `Foo ip1`, we are left with both case expressions.

    2. combineIdenticalAlts does a better job. For example (Simon Jacobi)
           data D = C0 | C1 | C2

           case e of
             DEFAULT -> e0
             C0      -> e1
             C1      -> e1

       When we apply combineIdenticalAlts to this expression, it can't
       combine the alts for C0 and C1, as we already have a default case.
       But if we apply refineDefaultAlt first, we get
           case e of
             C0 -> e1
             C1 -> e1
             C2 -> e0
       and combineIdenticalAlts can turn that into
           case e of
             DEFAULT -> e1
             C2 -> e0

       It isn't obvious that refineDefaultAlt does this but if you look
       at its one call site in GHC.Core.Opt.Simplify.Utils then the
       `imposs_deflt_cons` argument is populated with constructors which
       are matched elsewhere.

    There are two exceptions where we avoid refining a DEFAULT case:

    * Exception 1: Newtypes

      We can have a newtype, if we are just doing an eval:

        case x of { DEFAULT -> e }

      And we don't want to fill in a default for them!

    * Exception 2: `type data` declarations

      The data constructors for a `type data` declaration (see
      Note [Type data declarations] in GHC.Rename.Module) do not exist at the
      value level. Nevertheless, it is possible to strictly evaluate a value
      whose type is a `type data` declaration. Test case
      type-data/should_compile/T2294b.hs contains an example:

        type data T a where
          A :: T Int

        f :: T a -> ()
        f !x = ()

      We want to generate the following Core for f:

        f = \(@a) (x :: T a) ->
             case x of
               __DEFAULT -> ()

      Namely, we do _not_ want to match on `A`, as it doesn't exist at the value
      level! See wrinkle (W2b) in Note [Type data declarations] in GHC.Rename.Module

    Note [Combine identical alternatives]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If several alternatives are identical, merge them into a single
    DEFAULT alternative.  I've occasionally seen this making a big
    difference:

         case e of               =====>     case e of
           C _ -> f x                         D v -> ....v....
           D v -> ....v....                   DEFAULT -> f x
           DEFAULT -> f x

    The point is that we merge common RHSs, at least for the DEFAULT case.
    [One could do something more elaborate but I've never seen it needed.]
    To avoid an expensive test, we just merge branches equal to the *first*
    alternative; this picks up the common cases
         a) all branches equal
         b) some branches equal to the DEFAULT (which occurs first)

    The case where Combine Identical Alternatives transformation showed up
    was like this (base/Foreign/C/Err/Error.hs):

            x | p `is` 1 -> e1
              | p `is` 2 -> e2
            ...etc...

    where @is@ was something like

            p `is` n = p /= (-1) && p == n

    This gave rise to a horrible sequence of cases

            case p of
              (-1) -> $j p
              1    -> e1
              DEFAULT -> $j p

    and similarly in cascade for all the join points!

    Note [Combine identical alternatives: wrinkles]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    * It's important that we try to combine alternatives *before*
      simplifying them, rather than after. Reason: because
      Simplify.simplAlt may zap the occurrence info on the binders in the
      alternatives, which in turn defeats combineIdenticalAlts use of
      isDeadBinder (see #7360).

      You can see this in the call to combineIdenticalAlts in
      GHC.Core.Opt.Simplify.Utils.prepareAlts.  Here the alternatives have type InAlt
      (the "In" meaning input) rather than OutAlt.

    * combineIdenticalAlts does not work well for nullary constructors
          case x of y
             []    -> f []
             (_:_) -> f y
      Here we won't see that [] and y are the same.  Sigh! This problem
      is solved in CSE, in GHC.Core.Opt.CSE.combineAlts, which does a better version
      of combineIdenticalAlts. But sadly it doesn't have the occurrence info we have
      here.
      See Note [Combine case alts: awkward corner] in GHC.Core.Opt.CSE).

    Note [Care with impossible-constructors when combining alternatives]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have (#10538)
       data T = A | B | C | D

          case x::T of   (Imposs-default-cons {A,B})
             DEFAULT -> e1
             A -> e2
             B -> e1

    When calling combineIdentialAlts, we'll have computed that the
    "impossible constructors" for the DEFAULT alt is {A,B}, since if x is
    A or B we'll take the other alternatives.  But suppose we combine B
    into the DEFAULT, to get

          case x::T of   (Imposs-default-cons {A})
             DEFAULT -> e1
             A -> e2

    Then we must be careful to trim the impossible constructors to just {A},
    else we risk compiling 'e1' wrong!

    Not only that, but we take care when there is no DEFAULT beforehand,
    because we are introducing one.  Consider

       case x of   (Imposs-default-cons {A,B,C})
         A -> e1
         B -> e2
         C -> e1

    Then when combining the A and C alternatives we get

       case x of   (Imposs-default-cons {B})
         DEFAULT -> e1
         B -> e2

    Note that we have a new DEFAULT branch that we didn't have before.  So
    we need delete from the "impossible-default-constructors" all the
    known-con alternatives that we have eliminated. (In #11172 we
    missed the first one.)

    -}

    combineIdenticalAlts :: [AltCon]    -- Constructors that cannot match DEFAULT
                         -> [CoreAlt]
                         -> (Bool,      -- True <=> something happened
                             [AltCon],  -- New constructors that cannot match DEFAULT
                             [CoreAlt]) -- New alternatives
    -- See Note [Combine identical alternatives]
    -- True <=> we did some combining, result is a single DEFAULT alternative
    combineIdenticalAlts :: [AltCon] -> [Alt Id] -> (Bool, [AltCon], [Alt Id])
    combineIdenticalAlts [AltCon]
    imposs_deflt_cons (Alt AltCon
    con1 [Id]
    bndrs1 CoreExpr
    rhs1 : [Alt Id]
    rest_alts)
      | (Id -> Bool) -> [Id] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Id -> Bool
    isDeadBinder [Id]
    bndrs1    -- Remember the default
      , Bool -> Bool
    not ([Alt Id] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Id]
    elim_rest) -- alternative comes first
      = (Bool
    True, [AltCon]
    imposs_deflt_cons', Alt Id
    deflt_alt Alt Id -> [Alt Id] -> [Alt Id]
    forall a. a -> [a] -> [a]
    : [Alt Id]
    filtered_rest)
      where
        ([Alt Id]
    elim_rest, [Alt Id]
    filtered_rest) = (Alt Id -> Bool) -> [Alt Id] -> ([Alt Id], [Alt Id])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Alt Id -> Bool
    identical_to_alt1 [Alt Id]
    rest_alts
        deflt_alt :: Alt Id
    deflt_alt = AltCon -> [Id] -> CoreExpr -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] ([CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks ([[CoreTickish]] -> [CoreTickish]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[CoreTickish]]
    tickss) CoreExpr
    rhs1)

         -- See Note [Care with impossible-constructors when combining alternatives]
        imposs_deflt_cons' :: [AltCon]
    imposs_deflt_cons' = [AltCon]
    imposs_deflt_cons [AltCon] -> [AltCon] -> [AltCon]
    forall a. Ord a => [a] -> [a] -> [a]
    `minusList` [AltCon]
    elim_cons
        elim_cons :: [AltCon]
    elim_cons = [AltCon]
    elim_con1 [AltCon] -> [AltCon] -> [AltCon]
    forall a. [a] -> [a] -> [a]
    ++ (Alt Id -> AltCon) -> [Alt Id] -> [AltCon]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Alt AltCon
    con [Id]
    _ CoreExpr
    _) -> AltCon
    con) [Alt Id]
    elim_rest
        elim_con1 :: [AltCon]
    elim_con1 = case AltCon
    con1 of     -- Don't forget con1!
                      AltCon
    DEFAULT -> []
                      AltCon
    _       -> [AltCon
    con1]

        cheapEqTicked :: Expr b -> Expr b -> Bool
    cheapEqTicked Expr b
    e1 Expr b
    e2 = (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool
    forall b. (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool
    cheapEqExpr' CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable Expr b
    e1 Expr b
    e2
        identical_to_alt1 :: Alt Id -> Bool
    identical_to_alt1 (Alt AltCon
    _con [Id]
    bndrs CoreExpr
    rhs)
          = (Id -> Bool) -> [Id] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Id -> Bool
    isDeadBinder [Id]
    bndrs Bool -> Bool -> Bool
    && CoreExpr
    rhs CoreExpr -> CoreExpr -> Bool
    forall {b}. Expr b -> Expr b -> Bool
    `cheapEqTicked` CoreExpr
    rhs1
        tickss :: [[CoreTickish]]
    tickss = (Alt Id -> [CoreTickish]) -> [Alt Id] -> [[CoreTickish]]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Alt AltCon
    _ [Id]
    _ CoreExpr
    rhs) -> (CoreTickish -> Bool) -> CoreExpr -> [CoreTickish]
    forall b. (CoreTickish -> Bool) -> Expr b -> [CoreTickish]
    stripTicksT CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreExpr
    rhs) [Alt Id]
    elim_rest

    combineIdenticalAlts [AltCon]
    imposs_cons [Alt Id]
    alts
      = (Bool
    False, [AltCon]
    imposs_cons, [Alt Id]
    alts)

    -- Scales the multiplicity of the binders of a list of case alternatives. That
    -- is, in [C x1…xn -> u], the multiplicity of x1…xn is scaled.
    scaleAltsBy :: Mult -> [CoreAlt] -> [CoreAlt]
    scaleAltsBy :: Type -> [Alt Id] -> [Alt Id]
    scaleAltsBy Type
    w [Alt Id]
    alts = (Alt Id -> Alt Id) -> [Alt Id] -> [Alt Id]
    forall a b. (a -> b) -> [a] -> [b]
    map Alt Id -> Alt Id
    scaleAlt [Alt Id]
    alts
      where
        scaleAlt :: CoreAlt -> CoreAlt
        scaleAlt :: Alt Id -> Alt Id
    scaleAlt (Alt AltCon
    con [Id]
    bndrs CoreExpr
    rhs) = AltCon -> [Id] -> CoreExpr -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con ((Id -> Id) -> [Id] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Id
    scaleBndr [Id]
    bndrs) CoreExpr
    rhs

        scaleBndr :: CoreBndr -> CoreBndr
        scaleBndr :: Id -> Id
    scaleBndr Id
    b = Type -> Id -> Id
    scaleVarBy Type
    w Id
    b

    {- *********************************************************************
    *                                                                      *
                 exprIsTrivial
    *                                                                      *
    ************************************************************************

    Note [exprIsTrivial]
    ~~~~~~~~~~~~~~~~~~~~
    @exprIsTrivial@ is true of expressions we are unconditionally happy to
                    duplicate; simple variables and constants, and type
                    applications.  Note that primop Ids aren't considered
                    trivial unless

    Note [Variables are trivial]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    There used to be a gruesome test for (hasNoBinding v) in the
    Var case:
            exprIsTrivial (Var v) | hasNoBinding v = idArity v == 0
    The idea here is that a constructor worker, like \$wJust, is
    really short for (\x -> \$wJust x), because \$wJust has no binding.
    So it should be treated like a lambda.  Ditto unsaturated primops.
    But now constructor workers are not "have-no-binding" Ids.  And
    completely un-applied primops and foreign-call Ids are sufficiently
    rare that I plan to allow them to be duplicated and put up with
    saturating them.

    Note [Tick trivial]
    ~~~~~~~~~~~~~~~~~~~
    Ticks are only trivial if they are pure annotations. If we treat
    "tick<n> x" as trivial, it will be inlined inside lambdas and the
    entry count will be skewed, for example.  Furthermore "scc<n> x" will
    turn into just "x" in mkTick.

    Note [Empty case is trivial]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The expression (case (x::Int) Bool of {}) is just a type-changing
    case used when we are sure that 'x' will not return.  See
    Note [Empty case alternatives] in GHC.Core.

    If the scrutinee is trivial, then so is the whole expression; and the
    CoreToSTG pass in fact drops the case expression leaving only the
    scrutinee.

    Having more trivial expressions is good.  Moreover, if we don't treat
    it as trivial we may land up with let-bindings like
       let v = case x of {} in ...
    and after CoreToSTG that gives
       let v = x in ...
    and that confuses the code generator (#11155). So best to kill
    it off at source.
    -}

    {-# INLINE trivial_expr_fold #-}
    trivial_expr_fold :: (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r
    -- ^ The worker function for Note [exprIsTrivial] and Note [getIdFromTrivialExpr]
    -- This is meant to have the code of both functions in one place and make it
    -- easy to derive custom predicates.
    --
    -- (trivial_expr_fold k_id k_triv k_not_triv e)
    -- * returns (k_id x) if `e` is a variable `x` (with trivial wrapping)
    -- * returns (k_lit x) if `e` is a trivial literal `l` (with trivial wrapping)
    -- * returns k_triv if `e` is a literal, type, or coercion (with trivial wrapping)
    -- * returns k_not_triv otherwise
    --
    -- where "trivial wrapping" is
    -- * Type application or abstraction
    -- * Ticks other than `tickishIsCode`
    -- * `case e of {}` an empty case
    trivial_expr_fold :: forall r. (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r
    trivial_expr_fold Id -> r
    k_id Literal -> r
    k_lit r
    k_triv r
    k_not_triv = CoreExpr -> r
    go
      where
        -- If you change this function, be sure to change SetLevels.notWorthFloating
        -- as well!
        -- (Or yet better: Come up with a way to share code with this function.)
        go :: CoreExpr -> r
    go (Var Id
    v)                            = Id -> r
    k_id Id
    v  -- See Note [Variables are trivial]
        go (Lit Literal
    l)    | Literal -> Bool
    litIsTrivial Literal
    l        = Literal -> r
    k_lit Literal
    l
        go (Type Type
    _)                           = r
    k_triv
        go (Coercion Coercion
    _)                       = r
    k_triv
        go (App CoreExpr
    f CoreExpr
    t)  | Bool -> Bool
    not (CoreExpr -> Bool
    isRuntimeArg CoreExpr
    t)  = CoreExpr -> r
    go CoreExpr
    f
        go (Lam Id
    b CoreExpr
    e)  | Bool -> Bool
    not (Id -> Bool
    isRuntimeVar Id
    b)  = CoreExpr -> r
    go CoreExpr
    e
        go (Tick CoreTickish
    t CoreExpr
    e) | Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishIsCode CoreTickish
    t) = CoreExpr -> r
    go CoreExpr
    e              -- See Note [Tick trivial]
        go (Cast CoreExpr
    e Coercion
    _)                         = CoreExpr -> r
    go CoreExpr
    e
        go (Case CoreExpr
    e Id
    b Type
    _ [Alt Id]
    as)
          | [Alt Id] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Id]
    as
          = CoreExpr -> r
    go CoreExpr
    e     -- See Note [Empty case is trivial]
          | Just CoreExpr
    rhs <- CoreExpr -> Id -> [Alt Id] -> Maybe CoreExpr
    isUnsafeEqualityCase CoreExpr
    e Id
    b [Alt Id]
    as
          = CoreExpr -> r
    go CoreExpr
    rhs   -- See (U2) of Note [Implementing unsafeCoerce] in base:Unsafe.Coerce
        go CoreExpr
    _                                  = r
    k_not_triv

    exprIsTrivial :: CoreExpr -> Bool
    exprIsTrivial :: CoreExpr -> Bool
    exprIsTrivial CoreExpr
    e = (Id -> Bool)
    -> (Literal -> Bool) -> Bool -> Bool -> CoreExpr -> Bool
    forall r. (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r
    trivial_expr_fold (Bool -> Id -> Bool
    forall a b. a -> b -> a
    const Bool
    True) (Bool -> Literal -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Bool
    True Bool
    False CoreExpr
    e

    {-
    Note [getIdFromTrivialExpr]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When substituting in a breakpoint we need to strip away the type cruft
    from a trivial expression and get back to the Id.  The invariant is
    that the expression we're substituting was originally trivial
    according to exprIsTrivial, AND the expression is not a literal.
    See Note [substTickish] for how breakpoint substitution preserves
    this extra invariant.

    We also need this functionality in CorePrep to extract out Id of a
    function which we are saturating.  However, in this case we don't know
    if the variable actually refers to a literal; thus we use
    'getIdFromTrivialExpr_maybe' to handle this case.  See test
    T12076lit for an example where this matters.
    -}

    getIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Id
    -- See Note [getIdFromTrivialExpr]
    getIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Id
    getIdFromTrivialExpr CoreExpr
    e = (Id -> Id) -> (Literal -> Id) -> Id -> Id -> CoreExpr -> Id
    forall r. (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r
    trivial_expr_fold Id -> Id
    forall a. a -> a
    id (Id -> Literal -> Id
    forall a b. a -> b -> a
    const Id
    panic) Id
    panic Id
    panic CoreExpr
    e
      where
        panic :: Id
    panic = String -> SDoc -> Id
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getIdFromTrivialExpr" (CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e)

    getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
    getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
    getIdFromTrivialExpr_maybe CoreExpr
    e = (Id -> Maybe Id)
    -> (Literal -> Maybe Id)
    -> Maybe Id
    -> Maybe Id
    -> CoreExpr
    -> Maybe Id
    forall r. (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r
    trivial_expr_fold Id -> Maybe Id
    forall a. a -> Maybe a
    Just (Maybe Id -> Literal -> Maybe Id
    forall a b. a -> b -> a
    const Maybe Id
    forall a. Maybe a
    Nothing) Maybe Id
    forall a. Maybe a
    Nothing Maybe Id
    forall a. Maybe a
    Nothing CoreExpr
    e

    {- *********************************************************************
    *                                                                      *
                 exprIsDupable
    *                                                                      *
    ************************************************************************

    Note [exprIsDupable]
    ~~~~~~~~~~~~~~~~~~~~
    @exprIsDupable@ is true of expressions that can be duplicated at a modest
                    cost in code size.  This will only happen in different case
                    branches, so there's no issue about duplicating work.

                    That is, exprIsDupable returns True of (f x) even if
                    f is very very expensive to call.

                    Its only purpose is to avoid fruitless let-binding
                    and then inlining of case join points
    -}

    exprIsDupable :: Platform -> CoreExpr -> Bool
    exprIsDupable :: Platform -> CoreExpr -> Bool
    exprIsDupable Platform
    platform CoreExpr
    e
      = Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isJust (Int -> CoreExpr -> Maybe Int
    go Int
    dupAppSize CoreExpr
    e)
      where
        go :: Int -> CoreExpr -> Maybe Int
        go :: Int -> CoreExpr -> Maybe Int
    go Int
    n (Type {})     = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n
        go Int
    n (Coercion {}) = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n
        go Int
    n (Var {})      = Int -> Maybe Int
    decrement Int
    n
        go Int
    n (Tick CoreTickish
    _ CoreExpr
    e)    = Int -> CoreExpr -> Maybe Int
    go Int
    n CoreExpr
    e
        go Int
    n (Cast CoreExpr
    e Coercion
    _)    = Int -> CoreExpr -> Maybe Int
    go Int
    n CoreExpr
    e
        go Int
    n (App CoreExpr
    f CoreExpr
    a) | Just Int
    n' <- Int -> CoreExpr -> Maybe Int
    go Int
    n CoreExpr
    a = Int -> CoreExpr -> Maybe Int
    go Int
    n' CoreExpr
    f
        go Int
    n (Lit Literal
    lit) | Platform -> Literal -> Bool
    litIsDupable Platform
    platform Literal
    lit = Int -> Maybe Int
    decrement Int
    n
        go Int
    _ CoreExpr
    _ = Maybe Int
    forall a. Maybe a
    Nothing

        decrement :: Int -> Maybe Int
        decrement :: Int -> Maybe Int
    decrement Int
    0 = Maybe Int
    forall a. Maybe a
    Nothing
        decrement Int
    n = Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)

    dupAppSize :: Int
    dupAppSize :: Int
    dupAppSize = Int
    8   -- Size of term we are prepared to duplicate
                     -- This is *just* big enough to make test MethSharing
                     -- inline enough join points.  Really it should be
                     -- smaller, and could be if we fixed #4960.

    {-
    ************************************************************************
    *                                                                      *
                 exprIsCheap, exprIsExpandable
    *                                                                      *
    ************************************************************************

    Note [exprIsWorkFree]
    ~~~~~~~~~~~~~~~~~~~~~
    exprIsWorkFree is used when deciding whether to inline something; we
    don't inline it if doing so might duplicate work, by peeling off a
    complete copy of the expression.  Here we do not want even to
    duplicate a primop (#5623):
       eg   let x = a #+ b in x +# x
       we do not want to inline/duplicate x

    Previously we were a bit more liberal, which led to the primop-duplicating
    problem.  However, being more conservative did lead to a big regression in
    one nofib benchmark, wheel-sieve1.  The situation looks like this:

       let noFactor_sZ3 :: GHC.Types.Int -> GHC.Types.Bool
           noFactor_sZ3 = case s_adJ of _ { GHC.Types.I# x_aRs ->
             case GHC.Prim.<=# x_aRs 2 of _ {
               GHC.Types.False -> notDivBy ps_adM qs_adN;
               GHC.Types.True -> lvl_r2Eb }}
           go = \x. ...(noFactor (I# y))....(go x')...

    The function 'noFactor' is heap-allocated and then called.  Turns out
    that 'notDivBy' is strict in its THIRD arg, but that is invisible to
    the caller of noFactor, which therefore cannot do w/w and
    heap-allocates noFactor's argument.  At the moment (May 12) we are just
    going to put up with this, because the previous more aggressive inlining
    (which treated 'noFactor' as work-free) was duplicating primops, which
    in turn was making inner loops of array calculations runs slow (#5623)

    Note [Case expressions are work-free]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Are case-expressions work-free?  Consider
        let v = case x of (p,q) -> p
            go = \y -> ...case v of ...
    Should we inline 'v' at its use site inside the loop?  At the moment
    we do.  I experimented with saying that case are *not* work-free, but
    that increased allocation slightly.  It's a fairly small effect, and at
    the moment we go for the slightly more aggressive version which treats
    (case x of ....) as work-free if the alternatives are.

    Moreover it improves arities of overloaded functions where
    there is only dictionary selection (no construction) involved

    Note [exprIsCheap]
    ~~~~~~~~~~~~~~~~~~
    See also Note [Interaction of exprIsWorkFree and lone variables] in GHC.Core.Unfold

    @exprIsCheap@ looks at a Core expression and returns \tr{True} if
    it is obviously in weak head normal form, or is cheap to get to WHNF.
    Note that that's not the same as exprIsDupable; an expression might be
    big, and hence not dupable, but still cheap.

    By ``cheap'' we mean a computation we're willing to:
            push inside a lambda, or
            inline at more than one place
    That might mean it gets evaluated more than once, instead of being
    shared.  The main examples of things which aren't WHNF but are
    ``cheap'' are:

      *     case e of
              pi -> ei
            (where e, and all the ei are cheap)

      *     let x = e in b
            (where e and b are cheap)

      *     op x1 ... xn
            (where op is a cheap primitive operator)

      *     error "foo"
            (because we are happy to substitute it inside a lambda)

    Notice that a variable is considered 'cheap': we can push it inside a lambda,
    because sharing will make sure it is only evaluated once.

    Note [exprIsCheap and exprIsHNF]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Note that exprIsHNF does not imply exprIsCheap.  Eg
            let x = fac 20 in Just x
    This responds True to exprIsHNF (you can discard a seq), but
    False to exprIsCheap.

    Note [Arguments and let-bindings exprIsCheapX]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    What predicate should we apply to the argument of an application, or the
    RHS of a let-binding?

    We used to say "exprIsTrivial arg" due to concerns about duplicating
    nested constructor applications, but see #4978.  So now we just recursively
    use exprIsCheapX.

    We definitely want to treat let and app the same.  The principle here is
    that
       let x = blah in f x
    should behave equivalently to
       f blah

    This in turn means that the 'letrec g' does not prevent eta expansion
    in this (which it previously was):
        f = \x. let v = case x of
                          True -> letrec g = \w. blah
                                  in g
                          False -> \x. x
                in \w. v True
    -}

    --------------------
    exprIsWorkFree :: CoreExpr -> Bool   -- See Note [exprIsWorkFree]
    exprIsWorkFree :: CoreExpr -> Bool
    exprIsWorkFree CoreExpr
    e = CheapAppFun -> CoreExpr -> Bool
    exprIsCheapX CheapAppFun
    isWorkFreeApp CoreExpr
    e

    exprIsCheap :: CoreExpr -> Bool
    exprIsCheap :: CoreExpr -> Bool
    exprIsCheap CoreExpr
    e = CheapAppFun -> CoreExpr -> Bool
    exprIsCheapX CheapAppFun
    isCheapApp CoreExpr
    e

    exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool
    {-# INLINE exprIsCheapX #-}
    -- allow specialization of exprIsCheap and exprIsWorkFree
    -- instead of having an unknown call to ok_app
    exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool
    exprIsCheapX CheapAppFun
    ok_app CoreExpr
    e
      = CoreExpr -> Bool
    ok CoreExpr
    e
      where
        ok :: CoreExpr -> Bool
    ok CoreExpr
    e = Int -> CoreExpr -> Bool
    go Int
    0 CoreExpr
    e

        -- n is the number of value arguments
        go :: Int -> CoreExpr -> Bool
    go Int
    n (Var Id
    v)                      = CheapAppFun
    ok_app Id
    v Int
    n
        go Int
    _ (Lit {})                     = Bool
    True
        go Int
    _ (Type {})                    = Bool
    True
        go Int
    _ (Coercion {})                = Bool
    True
        go Int
    n (Cast CoreExpr
    e Coercion
    _)                   = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    e
        go Int
    n (Case CoreExpr
    scrut Id
    _ Type
    _ [Alt Id]
    alts)        = CoreExpr -> Bool
    ok CoreExpr
    scrut Bool -> Bool -> Bool
    &&
                                            [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [ Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    rhs | Alt AltCon
    _ [Id]
    _ CoreExpr
    rhs <- [Alt Id]
    alts ]
        go Int
    n (Tick CoreTickish
    t CoreExpr
    e) | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    t = Bool
    False
                        | Bool
    otherwise       = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    e
        go Int
    n (Lam Id
    x CoreExpr
    e)  | Id -> Bool
    isRuntimeVar Id
    x  = Int
    nInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    0 Bool -> Bool -> Bool
    || Int -> CoreExpr -> Bool
    go (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) CoreExpr
    e
                        | Bool
    otherwise       = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    e
        go Int
    n (App CoreExpr
    f CoreExpr
    e)  | CoreExpr -> Bool
    isRuntimeArg CoreExpr
    e  = Int -> CoreExpr -> Bool
    go (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) CoreExpr
    f Bool -> Bool -> Bool
    && CoreExpr -> Bool
    ok CoreExpr
    e
                        | Bool
    otherwise       = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    f
        go Int
    n (Let (NonRec Id
    _ CoreExpr
    r) CoreExpr
    e)         = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    e Bool -> Bool -> Bool
    && CoreExpr -> Bool
    ok CoreExpr
    r
        go Int
    n (Let (Rec [(Id, CoreExpr)]
    prs) CoreExpr
    e)            = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    e Bool -> Bool -> Bool
    && ((Id, CoreExpr) -> Bool) -> [(Id, CoreExpr)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (CoreExpr -> Bool
    ok (CoreExpr -> Bool)
    -> ((Id, CoreExpr) -> CoreExpr) -> (Id, CoreExpr) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Id, CoreExpr) -> CoreExpr
    forall a b. (a, b) -> b
    snd) [(Id, CoreExpr)]
    prs

          -- Case: see Note [Case expressions are work-free]
          -- App, Let: see Note [Arguments and let-bindings exprIsCheapX]

    {- Note [exprIsExpandable]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    An expression is "expandable" if we are willing to duplicate it, if doing
    so might make a RULE or case-of-constructor fire.  Consider
       let x = (a,b)
           y = build g
       in ....(case x of (p,q) -> rhs)....(foldr k z y)....

    We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold),
    but we do want

     * the case-expression to simplify
       (via exprIsConApp_maybe, exprIsLiteral_maybe)

     * the foldr/build RULE to fire
       (by expanding the unfolding during rule matching)

    So we classify the unfolding of a let-binding as "expandable" (via the
    uf_expandable field) if we want to do this kind of on-the-fly
    expansion.  Specifically:

    * True of constructor applications (K a b)

    * True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic.
      (NB: exprIsCheap might not be true of this)

    * False of case-expressions.  If we have
        let x = case ... in ...(case x of ...)...
      we won't simplify.  We have to inline x.  See #14688.

    * False of let-expressions (same reason); and in any case we
      float lets out of an RHS if doing so will reveal an expandable
      application (see SimplEnv.doFloatFromRhs).

    * Take care: exprIsExpandable should /not/ be true of primops.  I
      found this in test T5623a:
        let q = /\a. Ptr a (a +# b)
        in case q @ Float of Ptr v -> ...q...

      q's inlining should not be expandable, else exprIsConApp_maybe will
      say that (q @ Float) expands to (Ptr a (a +# b)), and that will
      duplicate the (a +# b) primop, which we should not do lightly.
      (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.)
    -}

    -------------------------------------
    exprIsExpandable :: CoreExpr -> Bool
    -- See Note [exprIsExpandable]
    exprIsExpandable :: CoreExpr -> Bool
    exprIsExpandable CoreExpr
    e
      = CoreExpr -> Bool
    ok CoreExpr
    e
      where
        ok :: CoreExpr -> Bool
    ok CoreExpr
    e = Int -> CoreExpr -> Bool
    go Int
    0 CoreExpr
    e

        -- n is the number of value arguments
        go :: Int -> CoreExpr -> Bool
    go Int
    n (Var Id
    v)                      = CheapAppFun
    isExpandableApp Id
    v Int
    n
        go Int
    _ (Lit {})                     = Bool
    True
        go Int
    _ (Type {})                    = Bool
    True
        go Int
    _ (Coercion {})                = Bool
    True
        go Int
    n (Cast CoreExpr
    e Coercion
    _)                   = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    e
        go Int
    n (Tick CoreTickish
    t CoreExpr
    e) | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    t = Bool
    False
                        | Bool
    otherwise       = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    e
        go Int
    n (Lam Id
    x CoreExpr
    e)  | Id -> Bool
    isRuntimeVar Id
    x  = Int
    nInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    0 Bool -> Bool -> Bool
    || Int -> CoreExpr -> Bool
    go (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) CoreExpr
    e
                        | Bool
    otherwise       = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    e
        go Int
    n (App CoreExpr
    f CoreExpr
    e)  | CoreExpr -> Bool
    isRuntimeArg CoreExpr
    e  = Int -> CoreExpr -> Bool
    go (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) CoreExpr
    f Bool -> Bool -> Bool
    && CoreExpr -> Bool
    ok CoreExpr
    e
                        | Bool
    otherwise       = Int -> CoreExpr -> Bool
    go Int
    n CoreExpr
    f
        go Int
    _ (Case {})                    = Bool
    False
        go Int
    _ (Let {})                     = Bool
    False

    -------------------------------------
    type CheapAppFun = Id -> Arity -> Bool
      -- Is an application of this function to n *value* args
      -- always cheap, assuming the arguments are cheap?
      -- True mainly of data constructors, partial applications;
      -- but with minor variations:
      --    isWorkFreeApp
      --    isCheapApp

    isWorkFreeApp :: CheapAppFun
    isWorkFreeApp :: CheapAppFun
    isWorkFreeApp Id
    fn Int
    n_val_args
      | Int
    n_val_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0           -- No value args
      = Bool
    True
      | Int
    n_val_args Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Id -> Int
    idArity Id
    fn   -- Partial application
      = Bool
    True
      | Bool
    otherwise
      = case Id -> IdDetails
    idDetails Id
    fn of
          DataConWorkId {} -> Bool
    True
          PrimOpId PrimOp
    op ConcreteTyVars
    _    -> PrimOp -> Bool
    primOpIsWorkFree PrimOp
    op
          IdDetails
    _                -> Bool
    False

    isCheapApp :: CheapAppFun
    isCheapApp :: CheapAppFun
    isCheapApp Id
    fn Int
    n_val_args
      | CheapAppFun
    isWorkFreeApp Id
    fn Int
    n_val_args = Bool
    True
      | Id -> Bool
    isDeadEndId Id
    fn              = Bool
    True  -- See Note [isCheapApp: bottoming functions]
      | Bool
    otherwise
      = case Id -> IdDetails
    idDetails Id
    fn of
          DataConWorkId {} -> Bool
    True  -- Actually handled by isWorkFreeApp
          RecSelId {}      -> Int
    n_val_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1  -- See Note [Record selection]
          ClassOpId {}     -> Int
    n_val_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
          PrimOpId PrimOp
    op ConcreteTyVars
    _    -> PrimOp -> Bool
    primOpIsCheap PrimOp
    op
          IdDetails
    _                -> Bool
    False
            -- In principle we should worry about primops
            -- that return a type variable, since the result
            -- might be applied to something, but I'm not going
            -- to bother to check the number of args

    isExpandableApp :: CheapAppFun
    isExpandableApp :: CheapAppFun
    isExpandableApp Id
    fn Int
    n_val_args
      | CheapAppFun
    isWorkFreeApp Id
    fn Int
    n_val_args = Bool
    True
      | Bool
    otherwise
      = case Id -> IdDetails
    idDetails Id
    fn of
          RecSelId {}  -> Int
    n_val_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1  -- See Note [Record selection]
          ClassOpId {} -> Int
    n_val_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
          PrimOpId {}  -> Bool
    False
          IdDetails
    _ | Id -> Bool
    isDeadEndId Id
    fn     -> Bool
    False
              -- See Note [isExpandableApp: bottoming functions]
            | Id -> Bool
    isConLikeId Id
    fn     -> Bool
    True
            | Bool
    all_args_are_preds -> Bool
    True
            | Bool
    otherwise          -> Bool
    False

      where
         -- See if all the arguments are PredTys (implicit params or classes)
         -- If so we'll regard it as expandable; see Note [Expandable overloadings]
         all_args_are_preds :: Bool
    all_args_are_preds = Int -> Type -> Bool
    forall {t}. (Eq t, Num t) => t -> Type -> Bool
    all_pred_args Int
    n_val_args (Id -> Type
    idType Id
    fn)

         all_pred_args :: t -> Type -> Bool
    all_pred_args t
    n_val_args Type
    ty
           | t
    n_val_args t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    0
           = Bool
    True

           | Just (PiTyBinder
    bndr, Type
    ty) <- Type -> Maybe (PiTyBinder, Type)
    splitPiTy_maybe Type
    ty
           = case PiTyBinder
    bndr of
               Named {}  -> t -> Type -> Bool
    all_pred_args t
    n_val_args Type
    ty
               Anon Scaled Type
    _ FunTyFlag
    af -> FunTyFlag -> Bool
    isInvisibleFunArg FunTyFlag
    af Bool -> Bool -> Bool
    && t -> Type -> Bool
    all_pred_args (t
    n_val_argst -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) Type
    ty

           | Bool
    otherwise
           = Bool
    False

    {- Note [isCheapApp: bottoming functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    I'm not sure why we have a special case for bottoming
    functions in isCheapApp.  Maybe we don't need it.

    Note [isExpandableApp: bottoming functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's important that isExpandableApp does not respond True to bottoming
    functions.  Recall  undefined :: HasCallStack => a
    Suppose isExpandableApp responded True to (undefined d), and we had:

      x = undefined <dict-expr>

    Then Simplify.prepareRhs would ANF the RHS:

      d = <dict-expr>
      x = undefined d

    This is already bad: we gain nothing from having x bound to (undefined
    var), unlike the case for data constructors.  Worse, we get the
    simplifier loop described in OccurAnal Note [Cascading inlines].
    Suppose x occurs just once; OccurAnal.occAnalNonRecRhs decides x will
    certainly_inline; so we end up inlining d right back into x; but in
    the end x doesn't inline because it is bottom (preInlineUnconditionally);
    so the process repeats.. We could elaborate the certainly_inline logic
    some more, but it's better just to treat bottoming bindings as
    non-expandable, because ANFing them is a bad idea in the first place.

    Note [Record selection]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    I'm experimenting with making record selection
    look cheap, so we will substitute it inside a
    lambda.  Particularly for dictionary field selection.

    BUT: Take care with (sel d x)!  The (sel d) might be cheap, but
    there's no guarantee that (sel d x) will be too.  Hence (n_val_args == 1)

    Note [Expandable overloadings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose the user wrote this
       {-# RULE  forall x. foo (negate x) = h x #-}
       f x = ....(foo (negate x))....
    They'd expect the rule to fire. But since negate is overloaded, we might
    get this:
        f = \d -> let n = negate d in \x -> ...foo (n x)...
    So we treat the application of a function (negate in this case) to a
    *dictionary* as expandable.  In effect, every function is CONLIKE when
    it's applied only to dictionaries.

    ************************************************************************
    *                                                                      *
                 exprOkForSpeculation
    *                                                                      *
    ************************************************************************
    -}

    -----------------------------
    -- | To a first approximation, 'exprOkForSpeculation' returns True of
    -- an expression that is:
    --
    --  * Safe to evaluate even if normal order eval might not
    --    evaluate the expression at all, and
    --
    --  * Safe /not/ to evaluate even if normal order would do so
    --
    -- More specifically, this means that:
    --  * A: Evaluation of the expression reaches weak-head-normal-form,
    --  * B: soon,
    --  * C: without causing a write side effect (e.g. writing a mutable variable).
    --
    -- In particular, an expression that may
    --  * throw a synchronous Haskell exception, or
    --  * risk an unchecked runtime exception (e.g. array
    --    out of bounds, divide by zero)
    -- is /not/ considered OK-for-speculation, as these violate condition A.
    --
    -- For 'exprOkToDiscard', condition A is weakened to allow expressions
    -- that might risk an unchecked runtime exception but must otherwise
    -- reach weak-head-normal-form.
    -- (Note that 'exprOkForSpeculation' implies 'exprOkToDiscard')
    --
    -- But in fact both functions are a bit more conservative than the above,
    -- in at least the following ways:
    --
    --  * W1: We do not take advantage of already-evaluated lifted variables.
    --        As a result, 'exprIsHNF' DOES NOT imply 'exprOkForSpeculation';
    --        if @y@ is a case-binder of lifted type, then @exprIsHNF y@ is
    --        'True', while @exprOkForSpeculation y@ is 'False'.
    --        See Note [exprOkForSpeculation and evaluated variables] for why.
    --  * W2: Read-effects on mutable variables are currently also included.
    --        See Note [Classifying primop effects] "GHC.Builtin.PrimOps".
    --  * W3: Currently, 'exprOkForSpeculation' always returns 'False' for
    --        let-expressions.  Lets can be stacked deeply, so we just give up.
    --        In any case, the argument of 'exprOkForSpeculation' is usually in
    --        a strict context, so any lets will have been floated away.
    --
    --
    -- As an example of the considerations in this test, consider:
    --
    -- > let x = case y# +# 1# of { r# -> I# r# }
    -- > in E
    --
    -- being translated to:
    --
    -- > case y# +# 1# of { r# ->
    -- >    let x = I# r#
    -- >    in E
    -- > }
    --
    -- We can only do this if the @y# +# 1#@ is ok for speculation: it has no
    -- side effects, and can't diverge or raise an exception.
    --
    --
    -- See also Note [Classifying primop effects] in "GHC.Builtin.PrimOps"
    -- and Note [Transformations affected by primop effects].
    --
    -- 'exprOkForSpeculation' is used to define Core's let-can-float
    -- invariant.  (See Note [Core let-can-float invariant] in
    -- "GHC.Core".)  It is therefore frequently called on arguments of
    -- unlifted type, especially via 'needsCaseBinding'.  But it is
    -- sometimes called on expressions of lifted type as well.  For
    -- example, see Note [Speculative evaluation] in "GHC.CoreToStg.Prep".

    exprOkForSpeculation, exprOkToDiscard :: CoreExpr -> Bool
    exprOkForSpeculation :: CoreExpr -> Bool
    exprOkForSpeculation = (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_always_ok PrimOp -> Bool
    primOpOkForSpeculation
    exprOkToDiscard :: CoreExpr -> Bool
    exprOkToDiscard      = (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_always_ok PrimOp -> Bool
    primOpOkToDiscard

    fun_always_ok :: Id -> Bool
    fun_always_ok :: Id -> Bool
    fun_always_ok Id
    _ = Bool
    True

    -- | A special version of 'exprOkForSpeculation' used during
    -- Note [Speculative evaluation]. When the predicate arg `fun_ok` returns False
    -- for `b`, then `b` is never considered ok-for-spec.
    exprOkForSpecEval :: (Id -> Bool) -> CoreExpr -> Bool
    exprOkForSpecEval :: (Id -> Bool) -> CoreExpr -> Bool
    exprOkForSpecEval Id -> Bool
    fun_ok = (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primOpOkForSpeculation

    expr_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    _ PrimOp -> Bool
    _ (Lit Literal
    _)      = Bool
    True
    expr_ok Id -> Bool
    _ PrimOp -> Bool
    _ (Type Type
    _)     = Bool
    True
    expr_ok Id -> Bool
    _ PrimOp -> Bool
    _ (Coercion Coercion
    _) = Bool
    True

    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok (Var Id
    v)    = (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool
    app_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok Id
    v []
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok (Cast CoreExpr
    e Coercion
    _) = (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok CoreExpr
    e
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok (Lam Id
    b CoreExpr
    e)
                     | Id -> Bool
    isTyVar Id
    b = (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok  CoreExpr
    e
                     | Bool
    otherwise = Bool
    True

    -- Tick annotations that *tick* cannot be speculated, because these
    -- are meant to identify whether or not (and how often) the particular
    -- source expression was evaluated at runtime.
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok (Tick CoreTickish
    tickish CoreExpr
    e)
       | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    tickish = Bool
    False
       | Bool
    otherwise             = (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok CoreExpr
    e

    expr_ok Id -> Bool
    _ PrimOp -> Bool
    _ (Let {}) = Bool
    False
    -- See W3 in the Haddock comment for exprOkForSpeculation

    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok (Case CoreExpr
    scrut Id
    bndr Type
    _ [Alt Id]
    alts)
      =  -- See Note [exprOkForSpeculation: case expressions]
         (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok CoreExpr
    scrut
      Bool -> Bool -> Bool
    && HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType (Id -> Type
    idType Id
    bndr)
          -- OK to call isUnliftedType: binders always have a fixed RuntimeRep
      Bool -> Bool -> Bool
    && (Alt Id -> Bool) -> [Alt Id] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\(Alt AltCon
    _ [Id]
    _ CoreExpr
    rhs) -> (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok CoreExpr
    rhs) [Alt Id]
    alts
      Bool -> Bool -> Bool
    && [Alt Id] -> Bool
    forall b. [Alt b] -> Bool
    altsAreExhaustive [Alt Id]
    alts

    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok CoreExpr
    other_expr
      | (CoreExpr
    expr, [CoreExpr]
    args) <- CoreExpr -> (CoreExpr, [CoreExpr])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs CoreExpr
    other_expr
      = case (CoreTickish -> Bool) -> CoreExpr -> CoreExpr
    forall b. (CoreTickish -> Bool) -> Expr b -> Expr b
    stripTicksTopE (Bool -> Bool
    not (Bool -> Bool) -> (CoreTickish -> Bool) -> CoreTickish -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts) CoreExpr
    expr of
            Var Id
    f ->
               (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool
    app_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok Id
    f [CoreExpr]
    args

            -- 'LitRubbish' is the only literal that can occur in the head of an
            -- application and will not be matched by the above case (Var /= Lit).
            -- See Note [How a rubbish literal can be the head of an application]
            -- in GHC.Types.Literal
            Lit Literal
    lit | Bool
    debugIsOn, Bool -> Bool
    not (Literal -> Bool
    isLitRubbish Literal
    lit)
                     -> String -> SDoc -> Bool
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Non-rubbish lit in app head" (Literal -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Literal
    lit)
                     | Bool
    otherwise
                     -> Bool
    True

            CoreExpr
    _ -> Bool
    False

    -----------------------------
    app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool
    app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool
    app_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok Id
    fun [CoreExpr]
    args
      | Bool -> Bool
    not (Id -> Bool
    fun_ok Id
    fun)
      = Bool
    False -- This code path is only taken for Note [Speculative evaluation]

      | Id -> Int
    idArity Id
    fun Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    n_val_args
      -- Partial application: just check passing the arguments is OK
      = Bool
    args_ok

      | Bool
    otherwise
      = case Id -> IdDetails
    idDetails Id
    fun of
          DFunId Bool
    new_type -> Bool -> Bool
    not Bool
    new_type
             -- DFuns terminate, unless the dict is implemented
             -- with a newtype in which case they may not

          DataConWorkId {} -> Bool
    args_ok
                    -- The strictness of the constructor has already
                    -- been expressed by its "wrapper", so we don't need
                    -- to take the arguments into account
                       -- Well, we thought so.  But it's definitely wrong!
                       -- See #20749 and Note [How untagged pointers can
                       -- end up in strict fields] in GHC.Stg.InferTags

          ClassOpId Class
    _ Bool
    is_terminating_result
            | Bool
    is_terminating_result -- See Note [exprOkForSpeculation and type classes]
            -> Bool -> SDoc -> Bool -> Bool
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Int
    n_val_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1) (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    fun SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    args) (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $
               Bool
    True
               -- assert: terminating result type => can't be applied;
               -- c.f the _other case below

          PrimOpId PrimOp
    op ConcreteTyVars
    _
            | PrimOp -> Bool
    primOpIsDiv PrimOp
    op
            , Lit Literal
    divisor <- [CoreExpr] -> CoreExpr
    forall a. HasCallStack => [a] -> a
    last [CoreExpr]
    args
                -- there can be 2 args (most div primops) or 3 args
                -- (WordQuotRem2Op), hence the use of last/init
            -> Bool -> Bool
    not (Literal -> Bool
    isZeroLit Literal
    divisor) Bool -> Bool -> Bool
    && (CoreExpr -> Bool) -> [CoreExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok) ([CoreExpr] -> [CoreExpr]
    forall a. HasCallStack => [a] -> [a]
    init [CoreExpr]
    args)
                  -- Special case for dividing operations that fail
                  -- In general they are NOT ok-for-speculation
                  -- (which primop_ok will catch), but they ARE OK
                  -- if the divisor is definitely non-zero.
                  -- Often there is a literal divisor, and this
                  -- can get rid of a thunk in an inner loop

            | Bool
    otherwise -> PrimOp -> Bool
    primop_ok PrimOp
    op Bool -> Bool -> Bool
    && Bool
    args_ok

          IdDetails
    _other  -- Unlifted and terminating types;
                  -- Also c.f. the Var case of exprIsHNF
             |  HasDebugCallStack => Type -> Bool
    Type -> Bool
    isTerminatingType Type
    fun_ty  -- See Note [exprOkForSpeculation and type classes]
             Bool -> Bool -> Bool
    || Type -> Bool
    definitelyUnliftedType Type
    fun_ty
             -> Bool -> SDoc -> Bool -> Bool
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Int
    n_val_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0) (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    fun SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    args)
                Bool
    True  -- Both terminating types (e.g. Eq a), and unlifted types (e.g. Int#)
                      -- are non-functions and so will have no value args.  The assert is
                      -- just to check this.
                      -- (If we added unlifted function types this would change,
                      -- and we'd need to actually test n_val_args == 0.)

             -- Functions that terminate fast without raising exceptions etc
             -- See (U12) of Note [Implementing unsafeCoerce]
             | Id
    fun Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    unsafeEqualityProofIdKey -> Bool
    True

             | Bool
    otherwise -> Bool
    False
                 -- NB: even in the nullary case, do /not/ check
                 --     for evaluated-ness of the fun;
                 --     see Note [exprOkForSpeculation and evaluated variables]
      where
        fun_ty :: Type
    fun_ty       = Id -> Type
    idType Id
    fun
        n_val_args :: Int
    n_val_args   = [CoreExpr] -> Int
    forall b. [Arg b] -> Int
    valArgCount [CoreExpr]
    args
        ([PiTyBinder]
    arg_tys, Type
    _) = Type -> ([PiTyBinder], Type)
    splitPiTys Type
    fun_ty

        -- Even if a function call itself is OK, any unlifted
        -- args are still evaluated eagerly and must be checked
        args_ok :: Bool
    args_ok = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ((PiTyBinder -> CoreExpr -> Bool)
    -> [PiTyBinder] -> [CoreExpr] -> [Bool]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith PiTyBinder -> CoreExpr -> Bool
    arg_ok [PiTyBinder]
    arg_tys [CoreExpr]
    args)
        arg_ok :: PiTyVarBinder -> CoreExpr -> Bool
        arg_ok :: PiTyBinder -> CoreExpr -> Bool
    arg_ok (Named ForAllTyBinder
    _) CoreExpr
    _ = Bool
    True   -- A type argument
        arg_ok (Anon Scaled Type
    ty FunTyFlag
    _) CoreExpr
    arg      -- A term argument
           | Type -> Bool
    definitelyLiftedType (Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing Scaled Type
    ty)
           = Bool
    True -- lifted args are not evaluated eagerly
           | Bool
    otherwise
           = (Id -> Bool) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok Id -> Bool
    fun_ok PrimOp -> Bool
    primop_ok CoreExpr
    arg

    -----------------------------
    altsAreExhaustive :: [Alt b] -> Bool
    -- True  <=> the case alternatives are definitely exhaustive
    -- False <=> they may or may not be
    altsAreExhaustive :: forall b. [Alt b] -> Bool
    altsAreExhaustive []
      = Bool
    True    -- The scrutinee never returns; see Note [Empty case alternatives] in GHC.Core
    altsAreExhaustive (Alt AltCon
    con1 [b]
    _ Expr b
    _ : [Alt b]
    alts)
      = case AltCon
    con1 of
          AltCon
    DEFAULT   -> Bool
    True
          LitAlt {} -> Bool
    False
          DataAlt DataCon
    c -> [Alt b]
    alts [Alt b] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthIs` (TyCon -> Int
    tyConFamilySize (DataCon -> TyCon
    dataConTyCon DataCon
    c) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
          -- It is possible to have an exhaustive case that does not
          -- enumerate all constructors, notably in a GADT match, but
          -- we behave conservatively here -- I don't think it's important
          -- enough to deserve special treatment

    -- | Should we look past this tick when eta-expanding the given function?
    --
    -- See Note [Ticks and mandatory eta expansion]
    -- Takes the function we are applying as argument.
    etaExpansionTick :: Id -> GenTickish pass -> Bool
    etaExpansionTick :: forall (pass :: TickishPass). Id -> GenTickish pass -> Bool
    etaExpansionTick Id
    id GenTickish pass
    t
      = Id -> Bool
    hasNoBinding Id
    id Bool -> Bool -> Bool
    &&
        ( GenTickish pass -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable GenTickish pass
    t Bool -> Bool -> Bool
    || GenTickish pass -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    isProfTick GenTickish pass
    t )

    {- Note [exprOkForSpeculation and type classes]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider (#22745, #15205)

      \(d :: C a b). case eq_sel (sc_sel d) of
                       (co :: t1 ~# t2) [Dead] ->  blah

    We know that
    * eq_sel's argument (sc_sel d) has dictionary type, so it definitely terminates
      (again Note [NON-BOTTOM-DICTS invariant] in GHC.Core)
    * eq_sel is simply a superclass selector, and hence is fast
    * The field that eq_sel picks is of unlifted type, and hence can't be bottom
      (remember the dictionary argument itself is non-bottom)

    So we can treat (eq_sel (sc_sel d)) as ok-for-speculation.  We must check

    a) That the function is a class-op, with IdDetails of ClassOpId

    b) That the result type of the class-op is terminating or unlifted.  E.g. for
         class C a => D a where ...
         class C a where { op :: a -> a }
       Since C is represented by a newtype, (sc_sel (d :: D a)) might
       not be terminating.

    Rather than repeatedly test if the result of the class-op is a
    terminating/unlifted type, we cache it as a field of ClassOpId. See
    GHC.Types.Id.Make.mkDictSelId for where this field is initialised.

    Note [exprOkForSpeculation: case expressions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    exprOkForSpeculation accepts very special case expressions.
    Reason: (a ==# b) is ok-for-speculation, but the litEq rules
    in GHC.Core.Opt.ConstantFold convert it (a ==# 3#) to
       case a of { DEFAULT -> 0#; 3# -> 1# }
    for excellent reasons described in
      GHC.Core.Opt.ConstantFold Note [The litEq rule: converting equality to case].
    So, annoyingly, we want that case expression to be
    ok-for-speculation too. Bother.

    But we restrict it sharply:

    * We restrict it to unlifted scrutinees. Consider this:
         case x of y {
           DEFAULT -> ... (let v::Int# = case y of { True  -> e1
                                                   ; False -> e2 }
                           in ...) ...

      Does the RHS of v satisfy the let-can-float invariant?  Previously we said
      yes, on the grounds that y is evaluated.  But the binder-swap done
      by GHC.Core.Opt.SetLevels would transform the inner alternative to
         DEFAULT -> ... (let v::Int# = case x of { ... }
                         in ...) ....
      which does /not/ satisfy the let-can-float invariant, because x is
      not evaluated. See Note [Binder-swap during float-out]
      in GHC.Core.Opt.SetLevels.  To avoid this awkwardness it seems simpler
      to stick to unlifted scrutinees where the issue does not
      arise.

    * We restrict it to exhaustive alternatives. A non-exhaustive
      case manifestly isn't ok-for-speculation. for example,
      this is a valid program (albeit a slightly dodgy one)
        let v = case x of { B -> ...; C -> ... }
        in case x of
             A -> ...
             _ ->  ...v...v....
      Should v be considered ok-for-speculation?  Its scrutinee may be
      evaluated, but the alternatives are incomplete so we should not
      evaluate it strictly.

      Now, all this is for lifted types, but it'd be the same for any
      finite unlifted type. We don't have many of them, but we might
      add unlifted algebraic types in due course.

    ----- Historical note: #15696: --------
      Previously GHC.Core.Opt.SetLevels used exprOkForSpeculation to guide
      floating of single-alternative cases; it now uses exprIsHNF
      Note [Floating single-alternative cases].

      But in those days, consider
        case e of x { DEAFULT ->
          ...(case x of y
                A -> ...
                _ -> ...(case (case x of { B -> p; C -> p }) of
                           I# r -> blah)...
      If GHC.Core.Opt.SetLevels considers the inner nested case as
      ok-for-speculation it can do case-floating (in GHC.Core.Opt.SetLevels).
      So we'd float to:
        case e of x { DEAFULT ->
        case (case x of { B -> p; C -> p }) of I# r ->
        ...(case x of y
                A -> ...
                _ -> ...blah...)...
      which is utterly bogus (seg fault); see #5453.

    ----- Historical note: #3717: --------
        foo :: Int -> Int
        foo 0 = 0
        foo n = (if n < 5 then 1 else 2) `seq` foo (n-1)

    In earlier GHCs, we got this:
        T.$wfoo =
          \ (ww :: GHC.Prim.Int#) ->
            case ww of ds {
              __DEFAULT -> case (case <# ds 5 of _ {
                              GHC.Types.False -> lvl1;
                              GHC.Types.True -> lvl})
                           of _ { __DEFAULT ->
                           T.$wfoo (GHC.Prim.-# ds_XkE 1) };
              0 -> 0 }

    Before join-points etc we could only get rid of two cases (which are
    redundant) by recognising that the (case <# ds 5 of { ... }) is
    ok-for-speculation, even though it has /lifted/ type.  But now join
    points do the job nicely.
    ------- End of historical note ------------

    Note [exprOkForSpeculation and evaluated variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider these examples:
     * case x of y { DEFAULT -> ....y.... }
       Should 'y' (alone) be considered ok-for-speculation?

     * case x of y { DEFAULT -> ....let z = dataToTagLarge# y... }
       Should (dataToTagLarge# y) be considered ok-for-spec? Recall that
         dataToTagLarge# :: forall a. a -> Int#
       must always evaluate its argument. (See also Note [DataToTag overview].)

    You could argue 'yes', because in the case alternative we know that
    'y' is evaluated.  But the binder-swap transformation, which is
    extremely useful for float-out, changes these expressions to
       case x of y { DEFAULT -> ....x.... }
       case x of y { DEFAULT -> ....let z = dataToTagLarge# x... }

    And now the expression does not obey the let-can-float invariant!  Yikes!
    Moreover we really might float (dataToTagLarge# x) outside the case,
    and then it really, really doesn't obey the let-can-float invariant.

    The solution is simple: exprOkForSpeculation does not try to take
    advantage of the evaluated-ness of (lifted) variables.  And it returns
    False (always) for primops that perform evaluation.  We achieve the latter
    by marking the relevant primops as "ThrowsException" or
    "ReadWriteEffect"; see also Note [Classifying primop effects] in
    GHC.Builtin.PrimOps.

    Note that exprIsHNF /can/ and does take advantage of evaluated-ness;
    it doesn't have the trickiness of the let-can-float invariant to worry about.

    ************************************************************************
    *                                                                      *
                 exprIsHNF, exprIsConLike
    *                                                                      *
    ************************************************************************
    -}

    -- Note [exprIsHNF]             See also Note [exprIsCheap and exprIsHNF]
    -- ~~~~~~~~~~~~~~~~
    -- | exprIsHNF returns true for expressions that are certainly /already/
    -- evaluated to /head/ normal form.  This is used to decide whether it's ok
    -- to perform case-to-let for lifted expressions, which changes:
    --
    -- > case x of x' { _ -> e }
    --
    --    into:
    --
    -- > let x' = x in e
    --
    -- and in so doing makes the binding lazy.
    --
    -- So, it does /not/ treat variables as evaluated, unless they say they are.
    -- However, it /does/ treat partial applications and constructor applications
    -- as values, even if their arguments are non-trivial, provided the argument
    -- type is lifted. For example, both of these are values:
    --
    -- > (:) (f x) (map f xs)
    -- > map (...redex...)
    --
    -- because 'seq' on such things completes immediately.
    --
    -- For unlifted argument types, we have to be careful:
    --
    -- > C (f x :: Int#)
    --
    -- Suppose @f x@ diverges; then @C (f x)@ is not a value.
    -- We check for this using needsCaseBinding below
    exprIsHNF :: CoreExpr -> Bool           -- True => Value-lambda, constructor, PAP
    exprIsHNF :: CoreExpr -> Bool
    exprIsHNF = HasDebugCallStack =>
    (Id -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    (Id -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    exprIsHNFlike Id -> Bool
    isDataConWorkId Unfolding -> Bool
    isEvaldUnfolding

    -- | Similar to 'exprIsHNF' but includes CONLIKE functions as well as
    -- data constructors. Conlike arguments are considered interesting by the
    -- inliner.
    exprIsConLike :: CoreExpr -> Bool       -- True => lambda, conlike, PAP
    exprIsConLike :: CoreExpr -> Bool
    exprIsConLike = HasDebugCallStack =>
    (Id -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    (Id -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    exprIsHNFlike Id -> Bool
    isConLikeId Unfolding -> Bool
    isConLikeUnfolding

    -- | Returns true for values or value-like expressions. These are lambdas,
    -- constructors / CONLIKE functions (as determined by the function argument)
    -- or PAPs.
    --
    exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    exprIsHNFlike :: HasDebugCallStack =>
    (Id -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    exprIsHNFlike Id -> Bool
    is_con Unfolding -> Bool
    is_con_unf = CoreExpr -> Bool
    is_hnf_like
      where
        is_hnf_like :: CoreExpr -> Bool
    is_hnf_like (Var Id
    v) -- NB: There are no value args at this point
          =  CheapAppFun
    id_app_is_value Id
    v Int
    0 -- Catches nullary constructors,
                                 --      so that [] and () are values, for example
                                 -- and (e.g.) primops that don't have unfoldings
          Bool -> Bool -> Bool
    || Unfolding -> Bool
    is_con_unf (IdUnfoldingFun
    idUnfolding Id
    v)
            -- Check the thing's unfolding; it might be bound to a value
            --   or to a guaranteed-evaluated variable (isEvaldUnfolding)
            --   Contrast with Note [exprOkForSpeculation and evaluated variables]
            -- We don't look through loop breakers here, which is a bit conservative
            -- but otherwise I worry that if an Id's unfolding is just itself,
            -- we could get an infinite loop

          Bool -> Bool -> Bool
    || Type -> Bool
    definitelyUnliftedType (Id -> Type
    idType Id
    v)
            -- Unlifted binders are always evaluated (#20140)

        is_hnf_like (Lit Literal
    l)          = Bool -> Bool
    not (Literal -> Bool
    isLitRubbish Literal
    l)
            -- Regarding a LitRubbish as ConLike leads to unproductive inlining in
            -- WWRec, see #20035
        is_hnf_like (Type Type
    _)         = Bool
    True       -- Types are honorary Values;
                                                  -- we don't mind copying them
        is_hnf_like (Coercion Coercion
    _)     = Bool
    True       -- Same for coercions
        is_hnf_like (Lam Id
    b CoreExpr
    e)        = Id -> Bool
    isRuntimeVar Id
    b Bool -> Bool -> Bool
    || CoreExpr -> Bool
    is_hnf_like CoreExpr
    e
        is_hnf_like (Tick CoreTickish
    tickish CoreExpr
    e) = Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    tickish)
                                       Bool -> Bool -> Bool
    && CoreExpr -> Bool
    is_hnf_like CoreExpr
    e
                                          -- See Note [exprIsHNF Tick]
        is_hnf_like (Cast CoreExpr
    e Coercion
    _)       = CoreExpr -> Bool
    is_hnf_like CoreExpr
    e
        is_hnf_like (App CoreExpr
    e CoreExpr
    a)
          | CoreExpr -> Bool
    forall b. Expr b -> Bool
    isValArg CoreExpr
    a               = CoreExpr -> Int -> Bool
    app_is_value CoreExpr
    e Int
    1
          | Bool
    otherwise                = CoreExpr -> Bool
    is_hnf_like CoreExpr
    e
        is_hnf_like (Let Bind Id
    _ CoreExpr
    e)        = CoreExpr -> Bool
    is_hnf_like CoreExpr
    e  -- Lazy let(rec)s don't affect us
        is_hnf_like (Case CoreExpr
    e Id
    b Type
    _ [Alt Id]
    as)
          | Just CoreExpr
    rhs <- CoreExpr -> Id -> [Alt Id] -> Maybe CoreExpr
    isUnsafeEqualityCase CoreExpr
    e Id
    b [Alt Id]
    as
          = CoreExpr -> Bool
    is_hnf_like CoreExpr
    rhs
        is_hnf_like CoreExpr
    _                = Bool
    False

        -- 'n' is the number of value args to which the expression is applied
        -- And n>0: there is at least one value argument
        app_is_value :: CoreExpr -> Int -> Bool
        app_is_value :: CoreExpr -> Int -> Bool
    app_is_value (Var Id
    f)    Int
    nva = CheapAppFun
    id_app_is_value Id
    f Int
    nva
        app_is_value (Tick CoreTickish
    _ CoreExpr
    f) Int
    nva = CoreExpr -> Int -> Bool
    app_is_value CoreExpr
    f Int
    nva
        app_is_value (Cast CoreExpr
    f Coercion
    _) Int
    nva = CoreExpr -> Int -> Bool
    app_is_value CoreExpr
    f Int
    nva
        app_is_value (App CoreExpr
    f CoreExpr
    a)  Int
    nva
          | CoreExpr -> Bool
    forall b. Expr b -> Bool
    isValArg CoreExpr
    a              =
            CoreExpr -> Int -> Bool
    app_is_value CoreExpr
    f (Int
    nva Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Bool -> Bool -> Bool
    &&
            Bool -> Bool
    not (HasDebugCallStack => Type -> CoreExpr -> Bool
    Type -> CoreExpr -> Bool
    needsCaseBinding (HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    a) CoreExpr
    a)
              -- For example  f (x /# y)  where f has arity two, and the first
              -- argument is unboxed. This is not a value!
              -- But  f 34#  is a value.
              -- NB: Check app_is_value first, the arity check is cheaper
          | Bool
    otherwise               = CoreExpr -> Int -> Bool
    app_is_value CoreExpr
    f Int
    nva
        app_is_value CoreExpr
    _          Int
    _   = Bool
    False

        id_app_is_value :: CheapAppFun
    id_app_is_value Id
    id Int
    n_val_args
           = Id -> Bool
    is_con Id
    id
           Bool -> Bool -> Bool
    || Id -> Int
    idArity Id
    id Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    n_val_args

    {-
    Note [exprIsHNF Tick]
    ~~~~~~~~~~~~~~~~~~~~~
    We can discard source annotations on HNFs as long as they aren't
    tick-like:

      scc c (\x . e)    =>  \x . e
      scc c (C x1..xn)  =>  C x1..xn

    So we regard these as HNFs.  Tick annotations that tick are not
    regarded as HNF if the expression they surround is HNF, because the
    tick is there to tell us that the expression was evaluated, so we
    don't want to discard a seq on it.
    -}

    -- | Can we bind this 'CoreExpr' at the top level?
    exprIsTopLevelBindable :: CoreExpr -> Type -> Bool
    -- See Note [Core top-level string literals]
    -- Precondition: exprType expr = ty
    -- Top-level literal strings can't even be wrapped in ticks
    --   see Note [Core top-level string literals] in "GHC.Core"
    exprIsTopLevelBindable :: CoreExpr -> Type -> Bool
    exprIsTopLevelBindable CoreExpr
    expr Type
    ty
      = Bool -> Bool
    not (Type -> Bool
    mightBeUnliftedType Type
    ty)
        -- Note that 'expr' may not have a fixed runtime representation here,
        -- consequently we must use 'mightBeUnliftedType' rather than 'isUnliftedType',
        -- as the latter would panic.
      Bool -> Bool -> Bool
    || CoreExpr -> Bool
    exprIsTickedString CoreExpr
    expr

    -- | Check if the expression is zero or more Ticks wrapped around a literal
    -- string.
    exprIsTickedString :: CoreExpr -> Bool
    exprIsTickedString :: CoreExpr -> Bool
    exprIsTickedString = Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe ByteString -> Bool)
    -> (CoreExpr -> Maybe ByteString) -> CoreExpr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreExpr -> Maybe ByteString
    exprIsTickedString_maybe

    -- | Extract a literal string from an expression that is zero or more Ticks
    -- wrapped around a literal string. Returns Nothing if the expression has a
    -- different shape.
    -- Used to "look through" Ticks in places that need to handle literal strings.
    exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString
    exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString
    exprIsTickedString_maybe (Lit (LitString ByteString
    bs)) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    bs
    exprIsTickedString_maybe (Tick CoreTickish
    t CoreExpr
    e)
      -- we don't tick literals with CostCentre ticks, compare to mkTick
      | CoreTickish -> TickishPlacement
    forall (pass :: TickishPass). GenTickish pass -> TickishPlacement
    tickishPlace CoreTickish
    t TickishPlacement -> TickishPlacement -> Bool
    forall a. Eq a => a -> a -> Bool
    == TickishPlacement
    PlaceCostCentre = Maybe ByteString
    forall a. Maybe a
    Nothing
      | Bool
    otherwise = CoreExpr -> Maybe ByteString
    exprIsTickedString_maybe CoreExpr
    e
    exprIsTickedString_maybe CoreExpr
    _ = Maybe ByteString
    forall a. Maybe a
    Nothing

    {-
    ************************************************************************
    *                                                                      *
                 Instantiating data constructors
    *                                                                      *
    ************************************************************************

    These InstPat functions go here to avoid circularity between DataCon and Id
    -}

    dataConRepInstPat   ::                 [Unique] -> Mult -> DataCon -> [Type] -> ([TyCoVar], [Id])
    dataConRepFSInstPat :: [FastString] -> [Unique] -> Mult -> DataCon -> [Type] -> ([TyCoVar], [Id])

    dataConRepInstPat :: [Unique] -> Type -> DataCon -> [Type] -> ([Id], [Id])
    dataConRepInstPat   = [FastString]
    -> [Unique] -> Type -> DataCon -> [Type] -> ([Id], [Id])
    dataConInstPat (FastString -> [FastString]
    forall a. a -> [a]
    repeat ((String -> FastString
    fsLit String
    "ipv")))
    dataConRepFSInstPat :: [FastString]
    -> [Unique] -> Type -> DataCon -> [Type] -> ([Id], [Id])
    dataConRepFSInstPat = [FastString]
    -> [Unique] -> Type -> DataCon -> [Type] -> ([Id], [Id])
    dataConInstPat

    dataConInstPat :: [FastString]          -- A long enough list of FSs to use for names
                   -> [Unique]              -- An equally long list of uniques, at least one for each binder
                   -> Mult                  -- The multiplicity annotation of the case expression: scales the multiplicity of variables
                   -> DataCon
                   -> [Type]                -- Types to instantiate the universally quantified tyvars
                   -> ([TyCoVar], [Id])     -- Return instantiated variables
    -- dataConInstPat arg_fun fss us mult con inst_tys returns a tuple
    -- (ex_tvs, arg_ids),
    --
    --   ex_tvs are intended to be used as binders for existential type args
    --
    --   arg_ids are intended to be used as binders for value arguments,
    --     and their types have been instantiated with inst_tys and ex_tys
    --     The arg_ids include both evidence and
    --     programmer-specified arguments (both after rep-ing)
    --
    -- Example.
    --  The following constructor T1
    --
    --  data T a where
    --    T1 :: forall b. Int -> b -> T(a,b)
    --    ...
    --
    --  has representation type
    --   forall a. forall a1. forall b. (a ~ (a1,b)) =>
    --     Int -> b -> T a
    --
    --  dataConInstPat fss us T1 (a1',b') will return
    --
    --  ([a1'', b''], [c :: (a1', b')~(a1'', b''), x :: Int, y :: b''])
    --
    --  where the double-primed variables are created with the FastStrings and
    --  Uniques given as fss and us
    dataConInstPat :: [FastString]
    -> [Unique] -> Type -> DataCon -> [Type] -> ([Id], [Id])
    dataConInstPat [FastString]
    fss [Unique]
    uniqs Type
    mult DataCon
    con [Type]
    inst_tys
      = Bool -> ([Id], [Id]) -> ([Id], [Id])
    forall a. HasCallStack => Bool -> a -> a
    assert ([Id]
    univ_tvs [Id] -> [Type] -> Bool
    forall a b. [a] -> [b] -> Bool
    `equalLength` [Type]
    inst_tys) (([Id], [Id]) -> ([Id], [Id])) -> ([Id], [Id]) -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $
        ([Id]
    ex_bndrs, [Id]
    arg_ids)
      where
        univ_tvs :: [Id]
    univ_tvs = DataCon -> [Id]
    dataConUnivTyVars DataCon
    con
        ex_tvs :: [Id]
    ex_tvs   = DataCon -> [Id]
    dataConExTyCoVars DataCon
    con
        arg_tys :: [Scaled Type]
    arg_tys  = DataCon -> [Scaled Type]
    dataConRepArgTys DataCon
    con
        arg_strs :: [StrictnessMark]
    arg_strs = DataCon -> [StrictnessMark]
    dataConRepStrictness DataCon
    con  -- 1-1 with arg_tys
        n_ex :: Int
    n_ex = [Id] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Id]
    ex_tvs

          -- split the Uniques and FastStrings
        ([Unique]
    ex_uniqs, [Unique]
    id_uniqs) = Int -> [Unique] -> ([Unique], [Unique])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n_ex [Unique]
    uniqs
        ([FastString]
    ex_fss,   [FastString]
    id_fss)   = Int -> [FastString] -> ([FastString], [FastString])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n_ex [FastString]
    fss

          -- Make the instantiating substitution for universals
        univ_subst :: Subst
    univ_subst = [Id] -> [Type] -> Subst
    HasDebugCallStack => [Id] -> [Type] -> Subst
    zipTvSubst [Id]
    univ_tvs [Type]
    inst_tys

          -- Make existential type variables, applying and extending the substitution
        (Subst
    full_subst, [Id]
    ex_bndrs) = (Subst -> (Id, FastString, Unique) -> (Subst, Id))
    -> Subst -> [(Id, FastString, Unique)] -> (Subst, [Id])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL Subst -> (Id, FastString, Unique) -> (Subst, Id)
    mk_ex_var Subst
    univ_subst
                                           ([Id] -> [FastString] -> [Unique] -> [(Id, FastString, Unique)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Id]
    ex_tvs [FastString]
    ex_fss [Unique]
    ex_uniqs)

        mk_ex_var :: Subst -> (TyCoVar, FastString, Unique) -> (Subst, TyCoVar)
        mk_ex_var :: Subst -> (Id, FastString, Unique) -> (Subst, Id)
    mk_ex_var Subst
    subst (Id
    tv, FastString
    fs, Unique
    uniq) = (Subst -> Id -> Id -> Subst
    Type.extendTCvSubstWithClone Subst
    subst Id
    tv
                                           Id
    new_tv
                                         , Id
    new_tv)
          where
            new_tv :: Id
    new_tv | Id -> Bool
    isTyVar Id
    tv
                   = Name -> Type -> Id
    mkTyVar (Unique -> FastString -> Name
    mkSysTvName Unique
    uniq FastString
    fs) Type
    kind
                   | Bool
    otherwise
                   = Name -> Type -> Id
    mkCoVar (Unique -> FastString -> Name
    mkSystemVarName Unique
    uniq FastString
    fs) Type
    kind
            kind :: Type
    kind   = Subst -> Type -> Type
    Type.substTyUnchecked Subst
    subst (Id -> Type
    varType Id
    tv)

          -- Make value vars, instantiating types
        arg_ids :: [Id]
    arg_ids = (Unique -> FastString -> Scaled Type -> StrictnessMark -> Id)
    -> [Unique]
    -> [FastString]
    -> [Scaled Type]
    -> [StrictnessMark]
    -> [Id]
    forall a b c d e.
    (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
    zipWith4 Unique -> FastString -> Scaled Type -> StrictnessMark -> Id
    mk_id_var [Unique]
    id_uniqs [FastString]
    id_fss [Scaled Type]
    arg_tys [StrictnessMark]
    arg_strs
        mk_id_var :: Unique -> FastString -> Scaled Type -> StrictnessMark -> Id
    mk_id_var Unique
    uniq FastString
    fs (Scaled Type
    m Type
    ty) StrictnessMark
    str
          = StrictnessMark -> Id -> Id
    setCaseBndrEvald StrictnessMark
    str (Id -> Id) -> Id -> Id
    forall a b. (a -> b) -> a -> b
    $  -- See Note [Mark evaluated arguments]
            OccName -> Unique -> Type -> Type -> SrcSpan -> Id
    mkUserLocalOrCoVar (FastString -> OccName
    mkVarOccFS FastString
    fs) Unique
    uniq
                               (Type
    mult Type -> Type -> Type
    `mkMultMul` Type
    m) (HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    Type.substTy Subst
    full_subst Type
    ty) SrcSpan
    noSrcSpan

    {-
    Note [Mark evaluated arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When pattern matching on a constructor with strict fields, the binder
    can have an 'evaldUnfolding'.  Moreover, it *should* have one, so that
    when loading an interface file unfolding like:
      data T = MkT !Int
      f x = case x of { MkT y -> let v::Int# = case y of I# n -> n+1
                                 in ... }
    we don't want Lint to complain.  The 'y' is evaluated, so the
    case in the RHS of the binding for 'v' is fine.  But only if we
    *know* that 'y' is evaluated.

    c.f. add_evals in GHC.Core.Opt.Simplify.simplAlt

    ************************************************************************
    *                                                                      *
             Equality
    *                                                                      *
    ************************************************************************
    -}

    -- | A cheap equality test which bales out fast!
    --      If it returns @True@ the arguments are definitely equal,
    --      otherwise, they may or may not be equal.
    cheapEqExpr :: Expr b -> Expr b -> Bool
    cheapEqExpr :: forall {b}. Expr b -> Expr b -> Bool
    cheapEqExpr = (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool
    forall b. (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool
    cheapEqExpr' (Bool -> CoreTickish -> Bool
    forall a b. a -> b -> a
    const Bool
    False)

    -- | Cheap expression equality test, can ignore ticks by type.
    cheapEqExpr' :: (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool
    {-# INLINE cheapEqExpr' #-}
    cheapEqExpr' :: forall b. (CoreTickish -> Bool) -> Expr b -> Expr b -> Bool
    cheapEqExpr' CoreTickish -> Bool
    ignoreTick Expr b
    e1 Expr b
    e2
      = Expr b -> Expr b -> Bool
    go Expr b
    e1 Expr b
    e2
      where
        go :: Expr b -> Expr b -> Bool
    go (Var Id
    v1)   (Var Id
    v2)         = Id
    v1 Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    v2
        go (Lit Literal
    lit1) (Lit Literal
    lit2)       = Literal
    lit1 Literal -> Literal -> Bool
    forall a. Eq a => a -> a -> Bool
    == Literal
    lit2
        go (Type Type
    t1)  (Type Type
    t2)        = Type
    t1 HasCallStack => Type -> Type -> Bool
    Type -> Type -> Bool
    `eqType` Type
    t2
        go (Coercion Coercion
    c1) (Coercion Coercion
    c2) = Coercion
    c1 Coercion -> Coercion -> Bool
    `eqCoercion` Coercion
    c2
        go (App Expr b
    f1 Expr b
    a1) (App Expr b
    f2 Expr b
    a2)     = Expr b
    f1 Expr b -> Expr b -> Bool
    `go` Expr b
    f2 Bool -> Bool -> Bool
    && Expr b
    a1 Expr b -> Expr b -> Bool
    `go` Expr b
    a2
        go (Cast Expr b
    e1 Coercion
    t1) (Cast Expr b
    e2 Coercion
    t2)   = Expr b
    e1 Expr b -> Expr b -> Bool
    `go` Expr b
    e2 Bool -> Bool -> Bool
    && Coercion
    t1 Coercion -> Coercion -> Bool
    `eqCoercion` Coercion
    t2

        go (Tick CoreTickish
    t1 Expr b
    e1) Expr b
    e2 | CoreTickish -> Bool
    ignoreTick CoreTickish
    t1 = Expr b -> Expr b -> Bool
    go Expr b
    e1 Expr b
    e2
        go Expr b
    e1 (Tick CoreTickish
    t2 Expr b
    e2) | CoreTickish -> Bool
    ignoreTick CoreTickish
    t2 = Expr b -> Expr b -> Bool
    go Expr b
    e1 Expr b
    e2
        go (Tick CoreTickish
    t1 Expr b
    e1) (Tick CoreTickish
    t2 Expr b
    e2) = CoreTickish
    t1 CoreTickish -> CoreTickish -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoreTickish
    t2 Bool -> Bool -> Bool
    && Expr b
    e1 Expr b -> Expr b -> Bool
    `go` Expr b
    e2

        go Expr b
    _ Expr b
    _ = Bool
    False

    -- Used by diffBinds, which is itself only used in GHC.Core.Lint.lintAnnots
    eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool
    eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool
    eqTickish RnEnv2
    env (Breakpoint XBreakpoint 'TickishPassCore
    lext Int
    lid [XTickishId 'TickishPassCore]
    lids Module
    lmod) (Breakpoint XBreakpoint 'TickishPassCore
    rext Int
    rid [XTickishId 'TickishPassCore]
    rids Module
    rmod)
          = Int
    lid Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    rid Bool -> Bool -> Bool
    &&
            (Id -> Id) -> [Id] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (RnEnv2 -> Id -> Id
    rnOccL RnEnv2
    env) [Id]
    [XTickishId 'TickishPassCore]
    lids [Id] -> [Id] -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Id -> Id) -> [Id] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (RnEnv2 -> Id -> Id
    rnOccR RnEnv2
    env) [Id]
    [XTickishId 'TickishPassCore]
    rids Bool -> Bool -> Bool
    &&
            NoExtField
    XBreakpoint 'TickishPassCore
    lext NoExtField -> NoExtField -> Bool
    forall a. Eq a => a -> a -> Bool
    == NoExtField
    XBreakpoint 'TickishPassCore
    rext Bool -> Bool -> Bool
    &&
            Module
    lmod Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    == Module
    rmod
    eqTickish RnEnv2
    _ CoreTickish
    l CoreTickish
    r = CoreTickish
    l CoreTickish -> CoreTickish -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoreTickish
    r

    -- | Finds differences between core bindings, see @diffExpr@.
    --
    -- The main problem here is that while we expect the binds to have the
    -- same order in both lists, this is not guaranteed. To do this
    -- properly we'd either have to do some sort of unification or check
    -- all possible mappings, which would be seriously expensive. So
    -- instead we simply match single bindings as far as we can. This
    -- leaves us just with mutually recursive and/or mismatching bindings,
    -- which we then speculatively match by ordering them. It's by no means
    -- perfect, but gets the job done well enough.
    --
    -- Only used in GHC.Core.Lint.lintAnnots
    diffBinds :: Bool -> RnEnv2 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
              -> ([SDoc], RnEnv2)
    diffBinds :: Bool
    -> RnEnv2
    -> [(Id, CoreExpr)]
    -> [(Id, CoreExpr)]
    -> ([SDoc], RnEnv2)
    diffBinds Bool
    top RnEnv2
    env [(Id, CoreExpr)]
    binds1 = Int
    -> RnEnv2
    -> [(Id, CoreExpr)]
    -> [(Id, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go ([(Id, CoreExpr)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Id, CoreExpr)]
    binds1) RnEnv2
    env [(Id, CoreExpr)]
    binds1
     where go :: Int
    -> RnEnv2
    -> [(Id, CoreExpr)]
    -> [(Id, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go Int
    _    RnEnv2
    env []     []
              = ([], RnEnv2
    env)
           go Int
    _fuel RnEnv2
    env [] [(Id, CoreExpr)]
    binds2
              -- No binds remaining to compare on the left? Bail out early.
              = (RnEnv2 -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] -> [SDoc]
    warn RnEnv2
    env [] [(Id, CoreExpr)]
    binds2, RnEnv2
    env)
           go Int
    _fuel RnEnv2
    env [(Id, CoreExpr)]
    binds1 []
              -- No binds remaining to compare on the right? Bail out early.
              = (RnEnv2 -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] -> [SDoc]
    warn RnEnv2
    env [(Id, CoreExpr)]
    binds1 [], RnEnv2
    env)
           go Int
    fuel RnEnv2
    env binds1 :: [(Id, CoreExpr)]
    binds1@((Id, CoreExpr)
    bind1:[(Id, CoreExpr)]
    _) binds2 :: [(Id, CoreExpr)]
    binds2@((Id, CoreExpr)
    _:[(Id, CoreExpr)]
    _)
              -- Iterated over all binds without finding a match? Then
              -- try speculatively matching binders by order.
              | Int
    fuel Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
              = if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ RnEnv2
    env RnEnv2 -> Id -> Bool
    `inRnEnvL` (Id, CoreExpr) -> Id
    forall a b. (a, b) -> a
    fst (Id, CoreExpr)
    bind1
                then let env' :: RnEnv2
    env' = ([Id] -> [Id] -> RnEnv2) -> ([Id], [Id]) -> RnEnv2
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (RnEnv2 -> [Id] -> [Id] -> RnEnv2
    rnBndrs2 RnEnv2
    env) (([Id], [Id]) -> RnEnv2) -> ([Id], [Id]) -> RnEnv2
    forall a b. (a -> b) -> a -> b
    $ [(Id, Id)] -> ([Id], [Id])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Id, Id)] -> ([Id], [Id])) -> [(Id, Id)] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $
                                [Id] -> [Id] -> [(Id, Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([Id] -> [Id]
    forall a. Ord a => [a] -> [a]
    sort ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ ((Id, CoreExpr) -> Id) -> [(Id, CoreExpr)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id, CoreExpr) -> Id
    forall a b. (a, b) -> a
    fst [(Id, CoreExpr)]
    binds1) ([Id] -> [Id]
    forall a. Ord a => [a] -> [a]
    sort ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ ((Id, CoreExpr) -> Id) -> [(Id, CoreExpr)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id, CoreExpr) -> Id
    forall a b. (a, b) -> a
    fst [(Id, CoreExpr)]
    binds2)
                     in Int
    -> RnEnv2
    -> [(Id, CoreExpr)]
    -> [(Id, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go ([(Id, CoreExpr)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Id, CoreExpr)]
    binds1) RnEnv2
    env' [(Id, CoreExpr)]
    binds1 [(Id, CoreExpr)]
    binds2
                -- If we have already tried that, give up
                else (RnEnv2 -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] -> [SDoc]
    warn RnEnv2
    env [(Id, CoreExpr)]
    binds1 [(Id, CoreExpr)]
    binds2, RnEnv2
    env)
           go Int
    fuel RnEnv2
    env ((Id
    bndr1,CoreExpr
    expr1):[(Id, CoreExpr)]
    binds1) [(Id, CoreExpr)]
    binds2
              | let matchExpr :: (Id, CoreExpr) -> Bool
    matchExpr (Id
    bndr,CoreExpr
    expr) =
                      (Id -> Bool
    isTyVar Id
    bndr Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    top Bool -> Bool -> Bool
    || [SDoc] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (RnEnv2 -> Id -> Id -> [SDoc]
    diffIdInfo RnEnv2
    env Id
    bndr Id
    bndr1)) Bool -> Bool -> Bool
    &&
                      [SDoc] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top (RnEnv2 -> Id -> Id -> RnEnv2
    rnBndr2 RnEnv2
    env Id
    bndr1 Id
    bndr) CoreExpr
    expr1 CoreExpr
    expr)

              , ([(Id, CoreExpr)]
    binds2l, (Id
    bndr2,CoreExpr
    _):[(Id, CoreExpr)]
    binds2r) <- ((Id, CoreExpr) -> Bool)
    -> [(Id, CoreExpr)] -> ([(Id, CoreExpr)], [(Id, CoreExpr)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Id, CoreExpr) -> Bool
    matchExpr [(Id, CoreExpr)]
    binds2
              = Int
    -> RnEnv2
    -> [(Id, CoreExpr)]
    -> [(Id, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go ([(Id, CoreExpr)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Id, CoreExpr)]
    binds1) (RnEnv2 -> Id -> Id -> RnEnv2
    rnBndr2 RnEnv2
    env Id
    bndr1 Id
    bndr2)
                    [(Id, CoreExpr)]
    binds1 ([(Id, CoreExpr)]
    binds2l [(Id, CoreExpr)] -> [(Id, CoreExpr)] -> [(Id, CoreExpr)]
    forall a. [a] -> [a] -> [a]
    ++ [(Id, CoreExpr)]
    binds2r)
              | Bool
    otherwise -- No match, so push back (FIXME O(n^2))
              = Int
    -> RnEnv2
    -> [(Id, CoreExpr)]
    -> [(Id, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go (Int
    fuelInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) RnEnv2
    env ([(Id, CoreExpr)]
    binds1[(Id, CoreExpr)] -> [(Id, CoreExpr)] -> [(Id, CoreExpr)]
    forall a. [a] -> [a] -> [a]
    ++[(Id
    bndr1,CoreExpr
    expr1)]) [(Id, CoreExpr)]
    binds2

           -- We have tried everything, but couldn't find a good match. So
           -- now we just return the comparison results when we pair up
           -- the binds in a pseudo-random order.
           warn :: RnEnv2 -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] -> [SDoc]
    warn RnEnv2
    env [(Id, CoreExpr)]
    binds1 [(Id, CoreExpr)]
    binds2 =
             (((Id, CoreExpr), (Id, CoreExpr)) -> [SDoc])
    -> [((Id, CoreExpr), (Id, CoreExpr))] -> [SDoc]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (((Id, CoreExpr) -> (Id, CoreExpr) -> [SDoc])
    -> ((Id, CoreExpr), (Id, CoreExpr)) -> [SDoc]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (RnEnv2 -> (Id, CoreExpr) -> (Id, CoreExpr) -> [SDoc]
    diffBind RnEnv2
    env)) ([(Id, CoreExpr)]
    -> [(Id, CoreExpr)] -> [((Id, CoreExpr), (Id, CoreExpr))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Id, CoreExpr)]
    binds1' [(Id, CoreExpr)]
    binds2') [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++
             String -> [(Id, CoreExpr)] -> [SDoc]
    forall {b}. OutputableBndr b => String -> [(b, Expr b)] -> [SDoc]
    unmatched String
    "unmatched left-hand:" (Int -> [(Id, CoreExpr)] -> [(Id, CoreExpr)]
    forall a. Int -> [a] -> [a]
    drop Int
    l [(Id, CoreExpr)]
    binds1') [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++
             String -> [(Id, CoreExpr)] -> [SDoc]
    forall {b}. OutputableBndr b => String -> [(b, Expr b)] -> [SDoc]
    unmatched String
    "unmatched right-hand:" (Int -> [(Id, CoreExpr)] -> [(Id, CoreExpr)]
    forall a. Int -> [a] -> [a]
    drop Int
    l [(Id, CoreExpr)]
    binds2')
            where binds1' :: [(Id, CoreExpr)]
    binds1' = ((Id, CoreExpr) -> (Id, CoreExpr) -> Ordering)
    -> [(Id, CoreExpr)] -> [(Id, CoreExpr)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((Id, CoreExpr) -> Id)
    -> (Id, CoreExpr) -> (Id, CoreExpr) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Id, CoreExpr) -> Id
    forall a b. (a, b) -> a
    fst) [(Id, CoreExpr)]
    binds1
                  binds2' :: [(Id, CoreExpr)]
    binds2' = ((Id, CoreExpr) -> (Id, CoreExpr) -> Ordering)
    -> [(Id, CoreExpr)] -> [(Id, CoreExpr)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((Id, CoreExpr) -> Id)
    -> (Id, CoreExpr) -> (Id, CoreExpr) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Id, CoreExpr) -> Id
    forall a b. (a, b) -> a
    fst) [(Id, CoreExpr)]
    binds2
                  l :: Int
    l = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min ([(Id, CoreExpr)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Id, CoreExpr)]
    binds1') ([(Id, CoreExpr)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Id, CoreExpr)]
    binds2')
           unmatched :: String -> [(b, Expr b)] -> [SDoc]
    unmatched String
    _   [] = []
           unmatched String
    txt [(b, Expr b)]
    bs = [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    txt SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Bind b -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([(b, Expr b)] -> Bind b
    forall b. [(b, Expr b)] -> Bind b
    Rec [(b, Expr b)]
    bs)]
           diffBind :: RnEnv2 -> (Id, CoreExpr) -> (Id, CoreExpr) -> [SDoc]
    diffBind RnEnv2
    env (Id
    bndr1,CoreExpr
    expr1) (Id
    bndr2,CoreExpr
    expr2)
             | ds :: [SDoc]
    ds@(SDoc
    _:[SDoc]
    _) <- Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    expr1 CoreExpr
    expr2
             = String -> Id -> Id -> [SDoc] -> [SDoc]
    locBind String
    "in binding" Id
    bndr1 Id
    bndr2 [SDoc]
    ds
             -- Special case for TyVar, which we checked were bound to the same types in
             -- diffExpr, but don't have any IdInfo we would panic if called diffIdInfo.
             -- These let-bound types are created temporarily by the simplifier but inlined
             -- immediately.
             | Id -> Bool
    isTyVar Id
    bndr1 Bool -> Bool -> Bool
    && Id -> Bool
    isTyVar Id
    bndr2
             = []
             | Bool
    otherwise
             = RnEnv2 -> Id -> Id -> [SDoc]
    diffIdInfo RnEnv2
    env Id
    bndr1 Id
    bndr2

    -- | Finds differences between core expressions, modulo alpha and
    -- renaming. Setting @top@ means that the @IdInfo@ of bindings will be
    -- checked for differences as well.
    diffExpr :: Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr :: Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    _   RnEnv2
    env (Var Id
    v1)   (Var Id
    v2)   | RnEnv2 -> Id -> Id
    rnOccL RnEnv2
    env Id
    v1 Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == RnEnv2 -> Id -> Id
    rnOccR RnEnv2
    env Id
    v2 = []
    diffExpr Bool
    _   RnEnv2
    _   (Lit Literal
    lit1) (Lit Literal
    lit2) | Literal
    lit1 Literal -> Literal -> Bool
    forall a. Eq a => a -> a -> Bool
    == Literal
    lit2                   = []
    diffExpr Bool
    _   RnEnv2
    env (Type Type
    t1)  (Type Type
    t2)  | HasCallStack => RnEnv2 -> Type -> Type -> Bool
    RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2              = []
    diffExpr Bool
    _   RnEnv2
    env (Coercion Coercion
    co1) (Coercion Coercion
    co2)
                                           | RnEnv2 -> Coercion -> Coercion -> Bool
    eqCoercionX RnEnv2
    env Coercion
    co1 Coercion
    co2        = []
    diffExpr Bool
    top RnEnv2
    env (Cast CoreExpr
    e1 Coercion
    co1)  (Cast CoreExpr
    e2 Coercion
    co2)
      | RnEnv2 -> Coercion -> Coercion -> Bool
    eqCoercionX RnEnv2
    env Coercion
    co1 Coercion
    co2                = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2
    diffExpr Bool
    top RnEnv2
    env (Tick CoreTickish
    n1 CoreExpr
    e1)   CoreExpr
    e2
      | Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishIsCode CoreTickish
    n1)                 = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    e1             (Tick CoreTickish
    n2 CoreExpr
    e2)
      | Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishIsCode CoreTickish
    n2)                 = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2
    diffExpr Bool
    top RnEnv2
    env (Tick CoreTickish
    n1 CoreExpr
    e1)   (Tick CoreTickish
    n2 CoreExpr
    e2)
      | RnEnv2 -> CoreTickish -> CoreTickish -> Bool
    eqTickish RnEnv2
    env CoreTickish
    n1 CoreTickish
    n2                    = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2
     -- The error message of failed pattern matches will contain
     -- generated names, which are allowed to differ.
    diffExpr Bool
    _   RnEnv2
    _   (App (App (Var Id
    absent) CoreExpr
    _) CoreExpr
    _)
                     (App (App (Var Id
    absent2) CoreExpr
    _) CoreExpr
    _)
      | Id -> Bool
    isDeadEndId Id
    absent Bool -> Bool -> Bool
    && Id -> Bool
    isDeadEndId Id
    absent2 = []
    diffExpr Bool
    top RnEnv2
    env (App CoreExpr
    f1 CoreExpr
    a1)    (App CoreExpr
    f2 CoreExpr
    a2)
      = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    f1 CoreExpr
    f2 [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    a1 CoreExpr
    a2
    diffExpr Bool
    top RnEnv2
    env (Lam Id
    b1 CoreExpr
    e1)  (Lam Id
    b2 CoreExpr
    e2)
      | HasCallStack => RnEnv2 -> Type -> Type -> Bool
    RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env (Id -> Type
    varType Id
    b1) (Id -> Type
    varType Id
    b2)   -- False for Id/TyVar combination
      = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top (RnEnv2 -> Id -> Id -> RnEnv2
    rnBndr2 RnEnv2
    env Id
    b1 Id
    b2) CoreExpr
    e1 CoreExpr
    e2
    diffExpr Bool
    top RnEnv2
    env (Let Bind Id
    bs1 CoreExpr
    e1) (Let Bind Id
    bs2 CoreExpr
    e2)
      = let ([SDoc]
    ds, RnEnv2
    env') = Bool
    -> RnEnv2
    -> [(Id, CoreExpr)]
    -> [(Id, CoreExpr)]
    -> ([SDoc], RnEnv2)
    diffBinds Bool
    top RnEnv2
    env ([Bind Id] -> [(Id, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds [Bind Id
    bs1]) ([Bind Id] -> [(Id, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds [Bind Id
    bs2])
        in [SDoc]
    ds [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env' CoreExpr
    e1 CoreExpr
    e2
    diffExpr Bool
    top RnEnv2
    env (Case CoreExpr
    e1 Id
    b1 Type
    t1 [Alt Id]
    a1) (Case CoreExpr
    e2 Id
    b2 Type
    t2 [Alt Id]
    a2)
      | [Alt Id] -> [Alt Id] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [Alt Id]
    a1 [Alt Id]
    a2 Bool -> Bool -> Bool
    && Bool -> Bool
    not ([Alt Id] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Id]
    a1) Bool -> Bool -> Bool
    || HasCallStack => RnEnv2 -> Type -> Type -> Bool
    RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2
        -- See Note [Empty case alternatives] in GHC.Data.TrieMap
      = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2 [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [[SDoc]] -> [SDoc]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((Alt Id -> Alt Id -> [SDoc]) -> [Alt Id] -> [Alt Id] -> [[SDoc]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Alt Id -> Alt Id -> [SDoc]
    diffAlt [Alt Id]
    a1 [Alt Id]
    a2)
      where env' :: RnEnv2
    env' = RnEnv2 -> Id -> Id -> RnEnv2
    rnBndr2 RnEnv2
    env Id
    b1 Id
    b2
            diffAlt :: Alt Id -> Alt Id -> [SDoc]
    diffAlt (Alt AltCon
    c1 [Id]
    bs1 CoreExpr
    e1) (Alt AltCon
    c2 [Id]
    bs2 CoreExpr
    e2)
              | AltCon
    c1 AltCon -> AltCon -> Bool
    forall a. Eq a => a -> a -> Bool
    /= AltCon
    c2  = [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "alt-cons " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> AltCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltCon
    c1 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    " /= " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> AltCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltCon
    c2]
              | Bool
    otherwise = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top (RnEnv2 -> [Id] -> [Id] -> RnEnv2
    rnBndrs2 RnEnv2
    env' [Id]
    bs1 [Id]
    bs2) CoreExpr
    e1 CoreExpr
    e2
    diffExpr Bool
    _  RnEnv2
    _ CoreExpr
    e1 CoreExpr
    e2
      = [[SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep [CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e1, String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "/=", CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e2]]

    -- | Find differences in @IdInfo@. We will especially check whether
    -- the unfoldings match, if present (see @diffUnfold@).
    diffIdInfo :: RnEnv2 -> Var -> Var -> [SDoc]
    diffIdInfo :: RnEnv2 -> Id -> Id -> [SDoc]
    diffIdInfo RnEnv2
    env Id
    bndr1 Id
    bndr2
      | IdInfo -> Int
    arityInfo IdInfo
    info1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> Int
    arityInfo IdInfo
    info2
        Bool -> Bool -> Bool
    && IdInfo -> CafInfo
    cafInfo IdInfo
    info1 CafInfo -> CafInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> CafInfo
    cafInfo IdInfo
    info2
        Bool -> Bool -> Bool
    && IdInfo -> OneShotInfo
    oneShotInfo IdInfo
    info1 OneShotInfo -> OneShotInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> OneShotInfo
    oneShotInfo IdInfo
    info2
        Bool -> Bool -> Bool
    && IdInfo -> InlinePragma
    inlinePragInfo IdInfo
    info1 InlinePragma -> InlinePragma -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> InlinePragma
    inlinePragInfo IdInfo
    info2
        Bool -> Bool -> Bool
    && IdInfo -> OccInfo
    occInfo IdInfo
    info1 OccInfo -> OccInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> OccInfo
    occInfo IdInfo
    info2
        Bool -> Bool -> Bool
    && IdInfo -> Demand
    demandInfo IdInfo
    info1 Demand -> Demand -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> Demand
    demandInfo IdInfo
    info2
        Bool -> Bool -> Bool
    && IdInfo -> Int
    callArityInfo IdInfo
    info1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> Int
    callArityInfo IdInfo
    info2
      = String -> Id -> Id -> [SDoc] -> [SDoc]
    locBind String
    "in unfolding of" Id
    bndr1 Id
    bndr2 ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $
        RnEnv2 -> Unfolding -> Unfolding -> [SDoc]
    diffUnfold RnEnv2
    env (IdInfo -> Unfolding
    realUnfoldingInfo IdInfo
    info1) (IdInfo -> Unfolding
    realUnfoldingInfo IdInfo
    info2)
      | Bool
    otherwise
      = String -> Id -> Id -> [SDoc] -> [SDoc]
    locBind String
    "in Id info of" Id
    bndr1 Id
    bndr2
        [[SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep [BindingSite -> Id -> SDoc
    forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LetBind Id
    bndr1, String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "/=", BindingSite -> Id -> SDoc
    forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LetBind Id
    bndr2]]
      where info1 :: IdInfo
    info1 = HasDebugCallStack => Id -> IdInfo
    Id -> IdInfo
    idInfo Id
    bndr1; info2 :: IdInfo
    info2 = HasDebugCallStack => Id -> IdInfo
    Id -> IdInfo
    idInfo Id
    bndr2

    -- | Find differences in unfoldings. Note that we will not check for
    -- differences of @IdInfo@ in unfoldings, as this is generally
    -- redundant, and can lead to an exponential blow-up in complexity.
    diffUnfold :: RnEnv2 -> Unfolding -> Unfolding -> [SDoc]
    diffUnfold :: RnEnv2 -> Unfolding -> Unfolding -> [SDoc]
    diffUnfold RnEnv2
    _   Unfolding
    NoUnfolding    Unfolding
    NoUnfolding                 = []
    diffUnfold RnEnv2
    _   Unfolding
    BootUnfolding  Unfolding
    BootUnfolding               = []
    diffUnfold RnEnv2
    _   (OtherCon [AltCon]
    cs1) (OtherCon [AltCon]
    cs2) | [AltCon]
    cs1 [AltCon] -> [AltCon] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [AltCon]
    cs2 = []
    diffUnfold RnEnv2
    env (DFunUnfolding [Id]
    bs1 DataCon
    c1 [CoreExpr]
    a1)
                   (DFunUnfolding [Id]
    bs2 DataCon
    c2 [CoreExpr]
    a2)
      | DataCon
    c1 DataCon -> DataCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon
    c2 Bool -> Bool -> Bool
    && [Id] -> [Id] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [Id]
    bs1 [Id]
    bs2
      = ((CoreExpr, CoreExpr) -> [SDoc])
    -> [(CoreExpr, CoreExpr)] -> [SDoc]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((CoreExpr -> CoreExpr -> [SDoc]) -> (CoreExpr, CoreExpr) -> [SDoc]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    False RnEnv2
    env')) ([CoreExpr] -> [CoreExpr] -> [(CoreExpr, CoreExpr)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [CoreExpr]
    a1 [CoreExpr]
    a2)
      where env' :: RnEnv2
    env' = RnEnv2 -> [Id] -> [Id] -> RnEnv2
    rnBndrs2 RnEnv2
    env [Id]
    bs1 [Id]
    bs2
    diffUnfold RnEnv2
    env (CoreUnfolding CoreExpr
    t1 UnfoldingSource
    _ Bool
    _ UnfoldingCache
    c1 UnfoldingGuidance
    g1)
                   (CoreUnfolding CoreExpr
    t2 UnfoldingSource
    _ Bool
    _ UnfoldingCache
    c2 UnfoldingGuidance
    g2)
      | UnfoldingCache
    c1 UnfoldingCache -> UnfoldingCache -> Bool
    forall a. Eq a => a -> a -> Bool
    == UnfoldingCache
    c2 Bool -> Bool -> Bool
    && UnfoldingGuidance
    g1 UnfoldingGuidance -> UnfoldingGuidance -> Bool
    forall a. Eq a => a -> a -> Bool
    == UnfoldingGuidance
    g2
      = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    False RnEnv2
    env CoreExpr
    t1 CoreExpr
    t2
    diffUnfold RnEnv2
    _   Unfolding
    uf1 Unfolding
    uf2
      = [[SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep [Unfolding -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unfolding
    uf1, String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "/=", Unfolding -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unfolding
    uf2]]

    -- | Add location information to diff messages
    locBind :: String -> Var -> Var -> [SDoc] -> [SDoc]
    locBind :: String -> Id -> Id -> [SDoc] -> [SDoc]
    locBind String
    loc Id
    b1 Id
    b2 [SDoc]
    diffs = (SDoc -> SDoc) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map SDoc -> SDoc
    addLoc [SDoc]
    diffs
      where addLoc :: SDoc -> SDoc
    addLoc SDoc
    d            = SDoc
    d SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    loc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    bindLoc))
            bindLoc :: SDoc
    bindLoc | Id
    b1 Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    b2  = Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    b1
                    | Bool
    otherwise = Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    b1 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '/' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    b2

    {- *********************************************************************
    *                                                                      *
    \subsection{Determining non-updatable right-hand-sides}
    *                                                                      *
    ************************************************************************

    Top-level constructor applications can usually be allocated
    statically, but they can't if the constructor, or any of the
    arguments, come from another DLL (because we can't refer to static
    labels in other DLLs).

    If this happens we simply make the RHS into an updatable thunk,
    and 'execute' it rather than allocating it statically.
    -}

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Type utilities}
    *                                                                      *
    ************************************************************************
    -}

    -- | True if the type has no non-bottom elements, e.g. when it is an empty
    -- datatype, or a GADT with non-satisfiable type parameters, e.g. Int :~: Bool.
    -- See Note [Bottoming expressions]
    --
    -- See Note [No alternatives lint check] for another use of this function.
    isEmptyTy :: Type -> Bool
    isEmptyTy :: Type -> Bool
    isEmptyTy Type
    ty
        -- Data types where, given the particular type parameters, no data
        -- constructor matches, are empty.
        -- This includes data types with no constructors, e.g. Data.Void.Void.
        | Just (TyCon
    tc, [Type]
    inst_tys) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty
        , Just [DataCon]
    dcs <- TyCon -> Maybe [DataCon]
    tyConDataCons_maybe TyCon
    tc
        , (DataCon -> Bool) -> [DataCon] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([Type] -> DataCon -> Bool
    dataConCannotMatch [Type]
    inst_tys) [DataCon]
    dcs
        = Bool
    True
        | Bool
    otherwise
        = Bool
    False

    -- | If @normSplitTyConApp_maybe _ ty = Just (tc, tys, co)@
    -- then @ty |> co = tc tys@. It's 'splitTyConApp_maybe', but looks through
    -- coercions via 'topNormaliseType_maybe'. Hence the \"norm\" prefix.
    normSplitTyConApp_maybe :: FamInstEnvs -> Type -> Maybe (TyCon, [Type], Coercion)
    normSplitTyConApp_maybe :: FamInstEnvs -> Type -> Maybe (TyCon, [Type], Coercion)
    normSplitTyConApp_maybe FamInstEnvs
    fam_envs Type
    ty
      | let Reduction Coercion
    co Type
    ty1 = FamInstEnvs -> Type -> Maybe Reduction
    topNormaliseType_maybe FamInstEnvs
    fam_envs Type
    ty
                               Maybe Reduction -> Reduction -> Reduction
    forall a. Maybe a -> a -> a
    `orElse` (Role -> Type -> Reduction
    mkReflRedn Role
    Representational Type
    ty)
      , Just (TyCon
    tc, [Type]
    tc_args) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty1
      = (TyCon, [Type], Coercion) -> Maybe (TyCon, [Type], Coercion)
    forall a. a -> Maybe a
    Just (TyCon
    tc, [Type]
    tc_args, Coercion
    co)
    normSplitTyConApp_maybe FamInstEnvs
    _ Type
    _ = Maybe (TyCon, [Type], Coercion)
    forall a. Maybe a
    Nothing

    {-
    *****************************************************
    *
    * InScopeSet things
    *
    *****************************************************
    -}

    extendInScopeSetBind :: InScopeSet -> CoreBind -> InScopeSet
    extendInScopeSetBind :: InScopeSet -> Bind Id -> InScopeSet
    extendInScopeSetBind (InScope VarSet
    in_scope) Bind Id
    binds
       = VarSet -> InScopeSet
    InScope (VarSet -> InScopeSet) -> VarSet -> InScopeSet
    forall a b. (a -> b) -> a -> b
    $ (VarSet -> Id -> VarSet) -> VarSet -> Bind Id -> VarSet
    forall a b. (a -> b -> a) -> a -> Bind b -> a
    foldBindersOfBindStrict VarSet -> Id -> VarSet
    extendVarSet VarSet
    in_scope Bind Id
    binds

    extendInScopeSetBndrs :: InScopeSet -> [CoreBind] -> InScopeSet
    extendInScopeSetBndrs :: InScopeSet -> [Bind Id] -> InScopeSet
    extendInScopeSetBndrs (InScope VarSet
    in_scope) [Bind Id]
    binds
       = VarSet -> InScopeSet
    InScope (VarSet -> InScopeSet) -> VarSet -> InScopeSet
    forall a b. (a -> b) -> a -> b
    $ (VarSet -> Id -> VarSet) -> VarSet -> [Bind Id] -> VarSet
    forall a b. (a -> b -> a) -> a -> [Bind b] -> a
    foldBindersOfBindsStrict VarSet -> Id -> VarSet
    extendVarSet VarSet
    in_scope [Bind Id]
    binds

    mkInScopeSetBndrs :: [CoreBind] -> InScopeSet
    mkInScopeSetBndrs :: [Bind Id] -> InScopeSet
    mkInScopeSetBndrs [Bind Id]
    binds = (InScopeSet -> Id -> InScopeSet)
    -> InScopeSet -> [Bind Id] -> InScopeSet
    forall a b. (a -> b -> a) -> a -> [Bind b] -> a
    foldBindersOfBindsStrict InScopeSet -> Id -> InScopeSet
    extendInScopeSet InScopeSet
    emptyInScopeSet [Bind Id]
    binds

    {-
    *****************************************************
    *
    * StaticPtr
    *
    *****************************************************
    -}

    -- | @collectMakeStaticArgs (makeStatic t srcLoc e)@ yields
    -- @Just (makeStatic, t, srcLoc, e)@.
    --
    -- Returns @Nothing@ for every other expression.
    collectMakeStaticArgs
      :: CoreExpr -> Maybe (CoreExpr, Type, CoreExpr, CoreExpr)
    collectMakeStaticArgs :: CoreExpr -> Maybe (CoreExpr, Type, CoreExpr, CoreExpr)
    collectMakeStaticArgs CoreExpr
    e
        | (fun :: CoreExpr
    fun@(Var Id
    b), [Type Type
    t, CoreExpr
    loc, CoreExpr
    arg], [CoreTickish]
    _) <- (CoreTickish -> Bool)
    -> CoreExpr -> (CoreExpr, [CoreExpr], [CoreTickish])
    forall b.
    (CoreTickish -> Bool)
    -> Expr b -> (Expr b, [Expr b], [CoreTickish])
    collectArgsTicks (Bool -> CoreTickish -> Bool
    forall a b. a -> b -> a
    const Bool
    True) CoreExpr
    e
        , Id -> Name
    idName Id
    b Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    makeStaticName = (CoreExpr, Type, CoreExpr, CoreExpr)
    -> Maybe (CoreExpr, Type, CoreExpr, CoreExpr)
    forall a. a -> Maybe a
    Just (CoreExpr
    fun, Type
    t, CoreExpr
    loc, CoreExpr
    arg)
    collectMakeStaticArgs CoreExpr
    _          = Maybe (CoreExpr, Type, CoreExpr, CoreExpr)
    forall a. Maybe a
    Nothing

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Join points}
    *                                                                      *
    ************************************************************************
    -}

    -- | Does this binding bind a join point (or a recursive group of join points)?
    isJoinBind :: CoreBind -> Bool
    isJoinBind :: Bind Id -> Bool
    isJoinBind (NonRec Id
    b CoreExpr
    _)       = Id -> Bool
    isJoinId Id
    b
    isJoinBind (Rec ((Id
    b, CoreExpr
    _) : [(Id, CoreExpr)]
    _)) = Id -> Bool
    isJoinId Id
    b
    isJoinBind Bind Id
    _                  = Bool
    False

    dumpIdInfoOfProgram :: Bool -> (IdInfo -> SDoc) -> CoreProgram -> SDoc
    dumpIdInfoOfProgram :: Bool -> (IdInfo -> SDoc) -> [Bind Id] -> SDoc
    dumpIdInfoOfProgram Bool
    dump_locals IdInfo -> SDoc
    ppr_id_info [Bind Id]
    binds = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((Id -> SDoc) -> [Id] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> SDoc
    printId [Id]
    ids)
      where
      ids :: [Id]
    ids = (Id -> Id -> Ordering) -> [Id] -> [Id]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Name -> Name -> Ordering
    stableNameCmp (Name -> Name -> Ordering) -> (Id -> Name) -> Id -> Id -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Id -> Name
    forall a. NamedThing a => a -> Name
    getName) ((Bind Id -> [Id]) -> [Bind Id] -> [Id]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Bind Id -> [Id]
    forall b. Bind b -> [b]
    getIds [Bind Id]
    binds)
      getIds :: Bind a -> [a]
    getIds (NonRec a
    i Expr a
    _) = [ a
    i ]
      getIds (Rec [(a, Expr a)]
    bs)     = ((a, Expr a) -> a) -> [(a, Expr a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, Expr a) -> a
    forall a b. (a, b) -> a
    fst [(a, Expr a)]
    bs
      -- By default only include full info for exported ids, unless we run in the verbose
      -- pprDebug mode.
      printId :: Id -> SDoc
    printId Id
    id | Id -> Bool
    isExportedId Id
    id Bool -> Bool -> Bool
    || Bool
    dump_locals = Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    id SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> (IdInfo -> SDoc
    ppr_id_info (HasDebugCallStack => Id -> IdInfo
    Id -> IdInfo
    idInfo Id
    id))
                 | Bool
    otherwise       = SDoc
    forall doc. IsOutput doc => doc
    empty

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Tag inference things}
    *                                                                      *
    ************************************************************************
    -}

    {- Note [Call-by-value for worker args]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we unbox a constructor with strict fields we want to
    preserve the information that some of the arguments came
    out of strict fields and therefore should be already properly
    tagged, however we can't express this directly in core.

    Instead what we do is generate a worker like this:

      data T = MkT A !B

      foo = case T of MkT a b -> $wfoo a b

      $wfoo a b = case b of b' -> rhs[b/b']

    This makes the worker strict in b causing us to use a more efficient
    calling convention for `b` where the caller needs to ensure `b` is
    properly tagged and evaluated before it's passed to $wfoo. See Note [CBV Function Ids].

    Usually the argument will be known to be properly tagged at the call site so there is
    no additional work for the caller and the worker can be more efficient since it can
    assume the presence of a tag.

    This is especially true for recursive functions like this:
        -- myPred expect it's argument properly tagged
        myPred !x = ...

        loop :: MyPair -> Int
        loop (MyPair !x !y) =
            case x of
                A -> 1
                B -> 2
                _ -> loop (MyPair (myPred x) (myPred y))

    Here we would ordinarily not be strict in y after unboxing.
    However if we pass it as a regular argument then this means on
    every iteration of loop we will incur an extra seq on y before
    we can pass it to `myPred` which isn't great! That is in STG after
    tag inference we get:

        Rec {
        Find.$wloop [InlPrag=[2], Occ=LoopBreaker]
          :: Find.MyEnum -> Find.MyEnum -> GHC.Prim.Int#
        [GblId[StrictWorker([!, ~])],
        Arity=2,
        Str=<1L><ML>,
        Unf=OtherCon []] =
            {} \r [x y]
                case x<TagProper> of x' [Occ=Once1] {
                  __DEFAULT ->
                      case y of y' [Occ=Once1] {
                      __DEFAULT ->
                      case Find.$wmyPred y' of pred_y [Occ=Once1] {
                      __DEFAULT ->
                      case Find.$wmyPred x' of pred_x [Occ=Once1] {
                      __DEFAULT -> Find.$wloop pred_x pred_y;
                      };
                      };
                  Find.A -> 1#;
                  Find.B -> 2#;
                };
        end Rec }

    Here comes the tricky part: If we make $wloop strict in both x/y and we get:

        Rec {
        Find.$wloop [InlPrag=[2], Occ=LoopBreaker]
          :: Find.MyEnum -> Find.MyEnum -> GHC.Prim.Int#
        [GblId[StrictWorker([!, !])],
        Arity=2,
        Str=<1L><!L>,
        Unf=OtherCon []] =
            {} \r [x y]
                case y<TagProper> of y' [Occ=Once1] { __DEFAULT ->
                case x<TagProper> of x' [Occ=Once1] {
                  __DEFAULT ->
                      case Find.$wmyPred y' of pred_y [Occ=Once1] {
                      __DEFAULT ->
                      case Find.$wmyPred x' of pred_x [Occ=Once1] {
                      __DEFAULT -> Find.$wloop pred_x pred_y;
                      };
                      };
                  Find.A -> 1#;
                  Find.B -> 2#;
                };
        end Rec }

    Here both x and y are known to be tagged in the function body since we pass strict worker args using unlifted cbv.
    This means the seqs on x and y both become no-ops and compared to the first version the seq on `y` disappears at runtime.

    The downside is that the caller of $wfoo potentially has to evaluate `y` once if we can't prove it isn't already evaluated.
    But y coming out of a strict field is in WHNF so safe to evaluated. And most of the time it will be properly tagged+evaluated
    already at the call site because of the Strict Field Invariant! See Note [Strict Field Invariant] for more in this.
    This makes GHC itself around 1% faster despite doing slightly more work! So this is generally quite good.

    We only apply this when we think there is a benefit in doing so however. There are a number of cases in which
    it would be useless to insert an extra seq. ShouldStrictifyIdForCbv tries to identify these to avoid churn in the
    simplifier. See Note [Which Ids should be strictified] for details on this.
    -}
    mkStrictFieldSeqs :: [(Id,StrictnessMark)] -> CoreExpr -> (CoreExpr)
    mkStrictFieldSeqs :: [(Id, StrictnessMark)] -> CoreExpr -> CoreExpr
    mkStrictFieldSeqs [(Id, StrictnessMark)]
    args CoreExpr
    rhs =
      ((Id, StrictnessMark) -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [(Id, StrictnessMark)] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Id, StrictnessMark) -> CoreExpr -> CoreExpr
    addEval CoreExpr
    rhs [(Id, StrictnessMark)]
    args
        where
          case_ty :: Type
    case_ty = HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    rhs
          addEval :: (Id,StrictnessMark) -> (CoreExpr) -> (CoreExpr)
          addEval :: (Id, StrictnessMark) -> CoreExpr -> CoreExpr
    addEval (Id
    arg_id,StrictnessMark
    arg_cbv) (CoreExpr
    rhs)
            -- Argument representing strict field.
            | StrictnessMark -> Bool
    isMarkedStrict StrictnessMark
    arg_cbv
            , Id -> Bool
    shouldStrictifyIdForCbv Id
    arg_id
            -- Make sure to remove unfoldings here to avoid the simplifier dropping those for OtherCon[] unfoldings.
            = CoreExpr -> Id -> Type -> [Alt Id] -> CoreExpr
    forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case (Id -> CoreExpr
    forall b. Id -> Expr b
    Var (Id -> CoreExpr) -> Id -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $! Id -> Id
    zapIdUnfolding Id
    arg_id) Id
    arg_id Type
    case_ty ([AltCon -> [Id] -> CoreExpr -> Alt Id
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] CoreExpr
    rhs])
            -- Normal argument
            | Bool
    otherwise = do
              rhs

    {- Note [Which Ids should be strictified]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For some arguments we would like to convince GHC to pass them call by value.
    One way to achieve this is described in see Note [Call-by-value for worker args].

    We separate the concerns of "should we pass this argument using cbv" and
    "should we do so by making the rhs strict in this argument".
    This note deals with the second part.

    There are multiple reasons why we might not want to insert a seq in the rhs to
    strictify a functions argument:

    1) The argument doesn't exist at runtime.

    For zero width types (like Types) there is no benefit as we don't operate on them
    at runtime at all. This includes things like void#, coercions and state tokens.

    2) The argument is a unlifted type.

    If the argument is a unlifted type the calling convention already is explicitly
    cbv. This means inserting a seq on this argument wouldn't do anything as the seq
    would be a no-op *and* it wouldn't affect the calling convention.

    3) The argument is absent.

    If the argument is absent in the body there is no advantage to it being passed as
    cbv to the function. The function won't ever look at it so we don't safe any work.

    This mostly happens for join point. For example we might have:

        data T = MkT ![Int] [Char]
        f t = case t of MkT xs{strict} ys-> snd (xs,ys)

    and abstract the case alternative to:

        f t = join j1 = \xs ys -> snd (xs,ys)
              in case t of MkT xs{strict} ys-> j1 xs xy

    While we "use" xs inside `j1` it's not used inside the function `snd` we pass it to.
    In short a absent demand means neither our RHS, nor any function we pass the argument
    to will inspect it. So there is no work to be saved by forcing `xs` early.

    NB: There is an edge case where if we rebox we *can* end up seqing an absent value.
    Note [Absent fillers] has an example of this. However this is so rare it's not worth
    caring about here.

    4) The argument is already strict.

    Consider this code:

        data T = MkT ![Int]
        f t = case t of MkT xs{strict} -> reverse xs

    The `xs{strict}` indicates that `xs` is used strictly by the `reverse xs`.
    If we do a w/w split, and add the extra eval on `xs`, we'll get

        $wf xs =
            case xs of xs1 ->
                let t = MkT xs1 in
                case t of MkT xs2 -> reverse xs2

    That's not wrong; but the w/w body will simplify to

        $wf xs = case xs of xs1 -> reverse xs1

    and now we'll drop the `case xs` because `xs1` is used strictly in its scope.
    Adding that eval was a waste of time.  So don't add it for strictly-demanded Ids.

    5) Functions

    Functions are tricky (see Note [TagInfo of functions] in InferTags).
    But the gist of it even if we make a higher order function argument strict
    we can't avoid the tag check when it's used later in the body.
    So there is no benefit.

    -}
    -- | Do we expect there to be any benefit if we make this var strict
    -- in order for it to get treated as as cbv argument?
    -- See Note [Which Ids should be strictified]
    -- See Note [CBV Function Ids] for more background.
    shouldStrictifyIdForCbv :: Var -> Bool
    shouldStrictifyIdForCbv :: Id -> Bool
    shouldStrictifyIdForCbv = Bool -> Id -> Bool
    wantCbvForId Bool
    False

    -- Like shouldStrictifyIdForCbv but also wants to use cbv for strict args.
    shouldUseCbvForId :: Var -> Bool
    shouldUseCbvForId :: Id -> Bool
    shouldUseCbvForId = Bool -> Id -> Bool
    wantCbvForId Bool
    True

    -- When we strictify we want to skip strict args otherwise the logic is the same
    -- as for shouldUseCbvForId so we common up the logic here.
    -- Basically returns true if it would be beneficial for runtime to pass this argument
    -- as CBV independent of weither or not it's correct. E.g. it might return true for lazy args
    -- we are not allowed to force.
    wantCbvForId :: Bool -> Var -> Bool
    wantCbvForId :: Bool -> Id -> Bool
    wantCbvForId Bool
    cbv_for_strict Id
    v
      -- Must be a runtime var.
      -- See Note [Which Ids should be strictified] point 1)
      | Id -> Bool
    isId Id
    v
      , Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ HasDebugCallStack => Type -> Bool
    Type -> Bool
    isZeroBitTy Type
    ty
      -- Unlifted things don't need special measures to be treated as cbv
      -- See Note [Which Ids should be strictified] point 2)
      , Type -> Bool
    mightBeLiftedType Type
    ty
      -- Functions sometimes get a zero tag so we can't eliminate the tag check.
      -- See Note [TagInfo of functions] in InferTags.
      -- See Note [Which Ids should be strictified] point 5)
      , Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Type -> Bool
    isFunTy Type
    ty
      -- If the var is strict already a seq is redundant.
      -- See Note [Which Ids should be strictified] point 4)
      , Bool -> Bool
    not (Demand -> Bool
    isStrictDmd Demand
    dmd) Bool -> Bool -> Bool
    || Bool
    cbv_for_strict
      -- If the var is absent a seq is almost always useless.
      -- See Note [Which Ids should be strictified] point 3)
      , Bool -> Bool
    not (Demand -> Bool
    isAbsDmd Demand
    dmd)
      = Bool
    True
      | Bool
    otherwise
      = Bool
    False
      where
        ty :: Type
    ty = Id -> Type
    idType Id
    v
        dmd :: Demand
    dmd = Id -> Demand
    idDemandInfo Id
    v

    {- *********************************************************************
    *                                                                      *
                 unsafeEqualityProof
    *                                                                      *
    ********************************************************************* -}

    isUnsafeEqualityCase :: CoreExpr -> Id -> [CoreAlt] -> Maybe CoreExpr
    -- See (U3) and (U4) in
    -- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce
    isUnsafeEqualityCase :: CoreExpr -> Id -> [Alt Id] -> Maybe CoreExpr
    isUnsafeEqualityCase CoreExpr
    scrut Id
    bndr [Alt Id]
    alts
      | [Alt AltCon
    ac [Id]
    _ CoreExpr
    rhs] <- [Alt Id]
    alts
      , DataAlt DataCon
    dc <- AltCon
    ac
      , DataCon
    dc DataCon -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    unsafeReflDataConKey
      , Id -> Bool
    isDeadBinder Id
    bndr
          -- We can only discard the case if the case-binder is dead
          -- It usually is, but see #18227
      , Var Id
    v `App` CoreExpr
    _ `App` CoreExpr
    _ `App` CoreExpr
    _ <- CoreExpr
    scrut
      , Id
    v Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    unsafeEqualityProofIdKey
          -- Check that the scrutinee really is unsafeEqualityProof
          -- and not, say, error
      = CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    rhs
      | Bool
    otherwise
      = Maybe CoreExpr
    forall a. Maybe a
    Nothing