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

    Utility functions on @Core@ syntax
    -}

    {-# LANGUAGE CPP #-}

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

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

            -- * Properties of expressions
            exprType, coreAltType, coreAltsType, mkLamType, mkLamTypes,
            mkFunctionType,
            isExprLevPoly,
            exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsDeadEnd,
            getIdFromTrivialExpr_maybe,
            exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
            exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprIsWorkFree,
            exprIsConLike,
            isCheapApp, isExpandableApp,
            exprIsTickedString, exprIsTickedString_maybe,
            exprIsTopLevelBindable,
            altsAreExhaustive,

            -- * Equality
            cheapEqExpr, cheapEqExpr', eqExpr,
            diffExpr, diffBinds,

            -- * Lambdas and eta reduction
            tryEtaReduce, zapLamBndrs,

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

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

            -- * StaticPtr
            collectMakeStaticArgs,

            -- * Join points
            isJoinBind,

            -- * unsafeEqualityProof
            isUnsafeEqualityProof,

            -- * Dumping stuff
            dumpIdInfoOfProgram
        ) where

    #include "HsVersions.h"

    import GHC.Prelude
    import GHC.Platform

    import GHC.Driver.Ppr

    import GHC.Core
    import GHC.Builtin.Names (absentErrorIdKey, makeStaticName, unsafeEqualityProofName)
    import GHC.Core.Ppr
    import GHC.Core.FVs( exprFreeVars )
    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.Core.DataCon
    import GHC.Builtin.PrimOps
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Core.Type as Type
    import GHC.Core.Predicate
    import GHC.Core.TyCo.Rep( TyCoBinder(..), TyBinder )
    import GHC.Core.Coercion
    import GHC.Core.TyCon
    import GHC.Core.Multiplicity
    import GHC.Types.Unique
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Data.FastString
    import GHC.Data.Maybe
    import GHC.Data.List.SetOps( minusList )
    import GHC.Types.Basic     ( Arity, FullArgCount )
    import GHC.Utils.Misc
    import GHC.Data.Pair
    import Data.ByteString     ( ByteString )
    import Data.Function       ( on )
    import Data.List           ( sort, sortBy, partition, zipWith4, mapAccumL )
    import Data.Ord            ( comparing )
    import GHC.Data.OrdList
    import qualified Data.Set as Set
    import GHC.Types.Unique.Set

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

    exprType :: 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 :: CoreExpr -> Type
    exprType (Var Var
    var)           = Var -> Type
    idType Var
    var
    exprType (Lit Literal
    lit)           = Literal -> Type
    literalType Literal
    lit
    exprType (Coercion CoercionR
    co)       = CoercionR -> Type
    coercionType CoercionR
    co
    exprType (Let Bind Var
    bind CoreExpr
    body)
      | NonRec Var
    tv CoreExpr
    rhs <- Bind Var
    bind    -- See Note [Type bindings]
      , Type Type
    ty <- CoreExpr
    rhs           = [Var] -> [Type] -> Type -> Type
    substTyWithUnchecked [Var
    tv] [Type
    ty] (CoreExpr -> Type
    exprType CoreExpr
    body)
      | Bool
    otherwise                = CoreExpr -> Type
    exprType CoreExpr
    body
    exprType (Case CoreExpr
    _ Var
    _ Type
    ty [Alt Var]
    _)     = Type
    ty
    exprType (Cast CoreExpr
    _ CoercionR
    co)         = Pair Type -> Type
    forall a. Pair a -> a
    pSnd (CoercionR -> Pair Type
    coercionKind CoercionR
    co)
    exprType (Tick CoreTickish
    _ CoreExpr
    e)          = CoreExpr -> Type
    exprType CoreExpr
    e
    exprType (Lam Var
    binder CoreExpr
    expr)   = Var -> Type -> Type
    mkLamType Var
    binder (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) -> CoreExpr -> Type -> [CoreExpr] -> Type
    applyTypeToArgs CoreExpr
    e (CoreExpr -> Type
    exprType CoreExpr
    fun) [CoreExpr]
    args

    exprType CoreExpr
    other = String -> SDoc -> Type
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "exprType" (CoreExpr -> SDoc
    forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr CoreExpr
    other)

    coreAltType :: CoreAlt -> Type
    -- ^ Returns the type of the alternatives right hand side
    coreAltType :: Alt Var -> Type
    coreAltType alt :: Alt Var
    alt@(Alt AltCon
    _ [Var]
    bs CoreExpr
    rhs)
      = case [Var] -> Type -> Maybe Type
    occCheckExpand [Var]
    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 Var -> SDoc
    forall a. OutputableBndr a => Alt a -> SDoc
    pprCoreAlt Alt Var
    alt SDoc -> SDoc -> SDoc
    $$ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    rhs_ty)
      where
        rhs_ty :: Type
    rhs_ty = 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 Var] -> Type
    coreAltsType (Alt Var
    alt:[Alt Var]
    _) = Alt Var -> Type
    coreAltType Alt Var
    alt
    coreAltsType []      = String -> Type
    forall a. String -> a
    panic String
    "corAltsType"

    mkLamType  :: 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.
    -- Always uses Inferred binders.
    mkLamTypes :: [Var] -> Type -> Type
    -- ^ 'mkLamType' for multiple type or value arguments

    mkLamType :: Var -> Type -> Type
    mkLamType Var
    v Type
    body_ty
       | Var -> Bool
    isTyVar Var
    v
       = Var -> ArgFlag -> Type -> Type
    mkForAllTy Var
    v ArgFlag
    Inferred Type
    body_ty

       | Var -> Bool
    isCoVar Var
    v
       , Var
    v Var -> VarSet -> Bool
    `elemVarSet` Type -> VarSet
    tyCoVarsOfType Type
    body_ty
       = Var -> ArgFlag -> Type -> Type
    mkForAllTy Var
    v ArgFlag
    Required Type
    body_ty

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

    mkFunctionType :: Mult -> Type -> Type -> Type
    -- This one works out the AnonArgFlag from the argument type
    -- See GHC.Types.Var Note [AnonArgFlag]
    mkFunctionType :: Type -> Type -> Type -> Type
    mkFunctionType Type
    mult Type
    arg_ty Type
    res_ty
       | HasDebugCallStack => Type -> Bool
    Type -> Bool
    isPredTy Type
    arg_ty -- See GHC.Types.Var Note [AnonArgFlag]
       = ASSERT(eqType mult Many)
         Type -> Type -> Type -> Type
    mkInvisFunTy Type
    mult Type
    arg_ty Type
    res_ty

       | Bool
    otherwise
       = Type -> Type -> Type -> Type
    mkVisFunTy Type
    mult Type
    arg_ty Type
    res_ty

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

    -- | Is this expression levity polymorphic? This should be the
    -- same as saying (isKindLevPoly . typeKind . exprType) but
    -- much faster.
    isExprLevPoly :: CoreExpr -> Bool
    isExprLevPoly :: CoreExpr -> Bool
    isExprLevPoly = CoreExpr -> Bool
    go
      where
       go :: CoreExpr -> Bool
    go (Var Var
    _)                      = Bool
    False  -- no levity-polymorphic binders
       go (Lit Literal
    _)                      = Bool
    False  -- no levity-polymorphic literals
       go e :: CoreExpr
    e@(App CoreExpr
    f CoreExpr
    _) | Bool -> Bool
    not (CoreExpr -> Bool
    forall {b}. OutputableBndr b => Expr b -> Bool
    go_app CoreExpr
    f) = Bool
    False
                      | Bool
    otherwise      = CoreExpr -> Bool
    check_type CoreExpr
    e
       go (Lam Var
    _ CoreExpr
    _)                    = Bool
    False
       go (Let Bind Var
    _ CoreExpr
    e)                    = CoreExpr -> Bool
    go CoreExpr
    e
       go e :: CoreExpr
    e@(Case {})                  = CoreExpr -> Bool
    check_type CoreExpr
    e -- checking type is fast
       go e :: CoreExpr
    e@(Cast {})                  = CoreExpr -> Bool
    check_type CoreExpr
    e
       go (Tick CoreTickish
    _ CoreExpr
    e)                   = CoreExpr -> Bool
    go CoreExpr
    e
       go e :: CoreExpr
    e@(Type {})                  = String -> SDoc -> Bool
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "isExprLevPoly ty" (CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e)
       go (Coercion {})                = Bool
    False  -- this case can happen in GHC.Core.Opt.SetLevels

       check_type :: CoreExpr -> Bool
    check_type = Type -> Bool
    isTypeLevPoly (Type -> Bool) -> (CoreExpr -> Type) -> CoreExpr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreExpr -> Type
    exprType  -- slow approach

          -- if the function is a variable (common case), check its
          -- levityInfo. This might mean we don't need to look up and compute
          -- on the type. Spec of these functions: return False if there is
          -- no possibility, ever, of this expression becoming levity polymorphic,
          -- no matter what it's applied to; return True otherwise.
          -- returning True is always safe. See also Note [Levity info] in
          -- IdInfo
       go_app :: Expr b -> Bool
    go_app (Var Var
    id)        = Bool -> Bool
    not (Var -> Bool
    isNeverLevPolyId Var
    id)
       go_app (Lit Literal
    _)         = Bool
    False
       go_app (App Expr b
    f Expr b
    _)       = Expr b -> Bool
    go_app Expr b
    f
       go_app (Lam b
    _ Expr b
    e)       = Expr b -> Bool
    go_app Expr b
    e
       go_app (Let Bind b
    _ Expr b
    e)       = Expr b -> Bool
    go_app Expr b
    e
       go_app (Case Expr b
    _ b
    _ Type
    ty [Alt b]
    _) = Type -> Bool
    resultIsLevPoly Type
    ty
       go_app (Cast Expr b
    _ CoercionR
    co)     = Type -> Bool
    resultIsLevPoly (CoercionR -> Type
    coercionRKind CoercionR
    co)
       go_app (Tick CoreTickish
    _ Expr b
    e)      = Expr b -> Bool
    go_app Expr b
    e
       go_app e :: Expr b
    e@(Type {})     = String -> SDoc -> Bool
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "isExprLevPoly app ty" (Expr b -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Expr b
    e)
       go_app e :: Expr b
    e@(Coercion {}) = String -> SDoc -> Bool
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "isExprLevPoly app co" (Expr b -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Expr b
    e)

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

    -- Not defined with applyTypeToArg because you can't print from GHC.Core.
    applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type
    -- ^ A more efficient version of 'applyTypeToArg' when we have several arguments.
    -- The first argument is just for debugging, and gives some context
    applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type
    applyTypeToArgs CoreExpr
    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 CoercionR
    co : [CoreExpr]
    args) = Type -> [Type] -> [CoreExpr] -> Type
    go_ty_args Type
    op_ty [CoercionR -> Type
    mkCoercionTy CoercionR
    co] [CoreExpr]
    args
        go Type
    op_ty (CoreExpr
    _ : [CoreExpr]
    args)           | Just (Type
    _, Type
    _, Type
    res_ty) <- Type -> Maybe (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 CoercionR
    co : [CoreExpr]
    args)
           = Type -> [Type] -> [CoreExpr] -> Type
    go_ty_args Type
    op_ty (CoercionR -> Type
    mkCoercionTy CoercionR
    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
    vcat [ String -> SDoc
    text String
    "Expression:" SDoc -> SDoc -> SDoc
    <+> CoreExpr -> SDoc
    forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr CoreExpr
    e
                         , String -> SDoc
    text String
    "Type:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    op_ty
                         , String -> SDoc
    text String
    "Args:" SDoc -> SDoc -> SDoc
    <+> [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    args
                         , String -> SDoc
    text String
    "Args':" SDoc -> SDoc -> SDoc
    <+> [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    as ]

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Attaching notes}
    *                                                                      *
    ************************************************************************
    -}

    -- | Wrap the given expression in the coercion safely, dropping
    -- identity coercions and coalescing nested coercions
    mkCast :: CoreExpr -> CoercionR -> CoreExpr
    mkCast :: CoreExpr -> CoercionR -> CoreExpr
    mkCast CoreExpr
    e CoercionR
    co
      | ASSERT2( coercionRole co == Representational
               , text "coercion" <+> ppr co <+> ptext (sLit "passed to mkCast")
                 <+> ppr e <+> text "has wrong role" <+> ppr (coercionRole co) )
        CoercionR -> Bool
    isReflCo CoercionR
    co
      = CoreExpr
    e

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

    mkCast (Cast CoreExpr
    expr CoercionR
    co2) CoercionR
    co
      = WARN(let { from_ty = coercionLKind co;
                   to_ty2  = coercionRKind co2 } in
                not (from_ty `eqType` to_ty2),
                 vcat ([ text "expr:" <+> ppr expr
                       , text "co2:" <+> ppr co2
                       , text "co:" <+> ppr co ]) )
        CoreExpr -> CoercionR -> CoreExpr
    mkCast CoreExpr
    expr (CoercionR -> CoercionR -> CoercionR
    mkTransCo CoercionR
    co2 CoercionR
    co)

    mkCast (Tick CoreTickish
    t CoreExpr
    expr) CoercionR
    co
       = CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t (CoreExpr -> CoercionR -> CoreExpr
    mkCast CoreExpr
    expr CoercionR
    co)

    mkCast CoreExpr
    expr CoercionR
    co
      = let from_ty :: Type
    from_ty = CoercionR -> Type
    coercionLKind CoercionR
    co in
        WARN( not (from_ty `eqType` exprType expr),
              text "Trying to coerce" <+> text "(" <> ppr expr
              $$ text "::" <+> ppr (exprType expr) <> text ")"
              $$ ppr co $$ ppr (coercionType co)
              $$ callStackDoc )
        (CoreExpr -> CoercionR -> CoreExpr
    forall b. Expr b -> CoercionR -> Expr b
    Cast CoreExpr
    expr CoercionR
    co)

    -- | 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' :: (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 CoercionR
    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 -> CoercionR -> CoreExpr)
    -> CoercionR -> CoreExpr -> CoreExpr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip CoreExpr -> CoercionR -> CoreExpr
    forall b. Expr b -> CoercionR -> Expr b
    Cast CoercionR
    co) CoreExpr -> CoreExpr
    rest CoreExpr
    e
        Coercion CoercionR
    co -> CoercionR -> CoreExpr
    forall b. CoercionR -> Expr b
    Coercion CoercionR
    co

        Lam Var
    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 (Var -> Bool
    isRuntimeVar Var
    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
    . Var -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam Var
    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
    $ Var -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam Var
    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 Var
    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 (Var -> Type
    idType Var
    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 (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 Var
    fun) [Expr b]
    args
               = Var -> Bool
    isConLikeId Var
    fun Bool -> Bool -> Bool
    && Var -> FullArgCount
    idArity Var
    fun FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Expr b] -> FullArgCount
    forall b. [Arg b] -> FullArgCount
    valArgCount [Expr b]
    args
            go (Cast Expr b
    f CoercionR
    _) [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 CoercionR
    c)       = Expr b -> CoercionR -> Expr b
    forall b. Expr b -> CoercionR -> Expr b
    Cast (Expr b -> Expr b
    go Expr b
    e) CoercionR
    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 CoercionR
    _)       = 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 :: 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 :: Var -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Var
    bndr CoreExpr
    rhs CoreExpr
    body
      | Var -> Bool
    isTyVar Var
    bndr                       = CoreExpr
    let_bind
      | Var -> Bool
    isCoVar Var
    bndr                       = if CoreExpr -> Bool
    forall b. Expr b -> Bool
    isCoArg CoreExpr
    rhs then CoreExpr
    let_bind
        {- See Note [Binding coercions] -}                  else CoreExpr
    case_bind
      | Var -> Bool
    isJoinId Var
    bndr                      = CoreExpr
    let_bind
      | Type -> CoreExpr -> Bool
    needsCaseBinding (Var -> Type
    idType Var
    bndr) CoreExpr
    rhs = CoreExpr
    case_bind
      | Bool
    otherwise                          = CoreExpr
    let_bind
      where
        case_bind :: CoreExpr
    case_bind = CoreExpr -> Var -> CoreExpr -> CoreExpr
    mkDefaultCase CoreExpr
    rhs Var
    bndr CoreExpr
    body
        let_bind :: CoreExpr
    let_bind  = Bind Var -> CoreExpr -> CoreExpr
    forall b. Bind b -> Expr b -> Expr b
    Let (Var -> CoreExpr -> Bind Var
    forall b. b -> Expr b -> Bind b
    NonRec Var
    bndr CoreExpr
    rhs) CoreExpr
    body

    -- | 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_app_invariant"
    needsCaseBinding :: Type -> CoreExpr -> Bool
    needsCaseBinding :: Type -> CoreExpr -> Bool
    needsCaseBinding Type
    ty CoreExpr
    rhs = HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType Type
    ty Bool -> Bool -> Bool
    && Bool -> Bool
    not (CoreExpr -> Bool
    exprOkForSpeculation CoreExpr
    rhs)
            -- Make a case expression instead of a let
            -- These can arise either from the desugarer,
            -- or from beta reductions: (\x.e) (x +# y)

    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 -> [Var] -> [Type] -> CoreExpr
    mkAltExpr (DataAlt DataCon
    con) [Var]
    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]
    ++ [Var] -> [CoreExpr]
    forall b. [Var] -> [Expr b]
    varsToCoreExprs [Var]
    args)
    mkAltExpr (LitAlt Literal
    lit) [] []
      = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit Literal
    lit
    mkAltExpr (LitAlt Literal
    _) [Var]
    _ [Type]
    _ = String -> CoreExpr
    forall a. String -> a
    panic String
    "mkAltExpr LitAlt"
    mkAltExpr AltCon
    DEFAULT [Var]
    _ [Type]
    _ = String -> CoreExpr
    forall a. String -> a
    panic String
    "mkAltExpr DEFAULT"

    mkDefaultCase :: CoreExpr -> Id -> CoreExpr -> CoreExpr
    -- Make (case x of y { DEFAULT -> e }
    mkDefaultCase :: CoreExpr -> Var -> CoreExpr -> CoreExpr
    mkDefaultCase CoreExpr
    scrut Var
    case_bndr CoreExpr
    body
      = CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
    forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    scrut Var
    case_bndr (CoreExpr -> Type
    exprType CoreExpr
    body) [AltCon -> [Var] -> CoreExpr -> Alt Var
    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 -> Var -> AltCon -> [Var] -> CoreExpr -> CoreExpr
    mkSingleAltCase CoreExpr
    scrut Var
    case_bndr AltCon
    con [Var]
    bndrs CoreExpr
    body
      = CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
    forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    scrut Var
    case_bndr Type
    case_ty [AltCon -> [Var] -> CoreExpr -> Alt Var
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con [Var]
    bndrs CoreExpr
    body]
      where
        body_ty :: Type
    body_ty = CoreExpr -> Type
    exprType CoreExpr
    body

        case_ty :: Type
    case_ty -- See Note [Care with the type of a case expression]
          | Just Type
    body_ty' <- [Var] -> Type -> Maybe Type
    occCheckExpand [Var]
    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
    $$ [Var] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Var]
    bndrs SDoc -> SDoc -> SDoc
    $$ 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) = ASSERT( null args ) (alts, Just 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 -> ASSERT( not (con1 == DEFAULT) ) go alts 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.
    -}

    ---------------------------------
    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 = ASSERT( null args ) []
    trimConArgs (LitAlt Literal
    _)   [CoreExpr]
    args = ASSERT( null args ) []
    trimConArgs (DataAlt DataCon
    dc) [CoreExpr]
    args = [Var] -> [CoreExpr] -> [CoreExpr]
    forall b a. [b] -> [a] -> [a]
    dropList (DataCon -> [Var]
    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, [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)
      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 Var]
    -> (Bool, [Alt Var])
    refineDefaultAlt [Unique]
    us Type
    mult TyCon
    tycon [Type]
    tys [AltCon]
    imposs_deflt_cons [Alt Var]
    all_alts
      | Alt AltCon
    DEFAULT [Var]
    _ CoreExpr
    rhs : [Alt Var]
    rest_alts <- [Alt Var]
    all_alts
      , TyCon -> Bool
    isAlgTyCon TyCon
    tycon            -- It's a data type, tuple, or unboxed tuples.
      , Bool -> Bool
    not (TyCon -> Bool
    isNewTyCon TyCon
    tycon)      -- 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!
      , 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 Var]
    rest_alts)

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

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

      | Bool
    debugIsOn, TyCon -> Bool
    isAlgTyCon TyCon
    tycon, [DataCon] -> 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 Var]
    all_alts)

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

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

    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 Var] -> (Bool, [AltCon], [Alt Var])
    combineIdenticalAlts [AltCon]
    imposs_deflt_cons (Alt AltCon
    con1 [Var]
    bndrs1 CoreExpr
    rhs1 : [Alt Var]
    rest_alts)
      | (Var -> Bool) -> [Var] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Var -> Bool
    isDeadBinder [Var]
    bndrs1    -- Remember the default
      , Bool -> Bool
    not ([Alt Var] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Var]
    elim_rest) -- alternative comes first
      = (Bool
    True, [AltCon]
    imposs_deflt_cons', Alt Var
    deflt_alt Alt Var -> [Alt Var] -> [Alt Var]
    forall a. a -> [a] -> [a]
    : [Alt Var]
    filtered_rest)
      where
        ([Alt Var]
    elim_rest, [Alt Var]
    filtered_rest) = (Alt Var -> Bool) -> [Alt Var] -> ([Alt Var], [Alt Var])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Alt Var -> Bool
    identical_to_alt1 [Alt Var]
    rest_alts
        deflt_alt :: Alt Var
    deflt_alt = AltCon -> [Var] -> CoreExpr -> Alt Var
    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 Var -> AltCon) -> [Alt Var] -> [AltCon]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Alt AltCon
    con [Var]
    _ CoreExpr
    _) -> AltCon
    con) [Alt Var]
    elim_rest
        elim_con1 :: [AltCon]
    elim_con1 = case AltCon
    con1 of     -- Don't forget con1!
                      AltCon
    DEFAULT -> []  -- See Note [
                      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 Var -> Bool
    identical_to_alt1 (Alt AltCon
    _con [Var]
    bndrs CoreExpr
    rhs)
          = (Var -> Bool) -> [Var] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Var -> Bool
    isDeadBinder [Var]
    bndrs Bool -> Bool -> Bool
    && CoreExpr
    rhs CoreExpr -> CoreExpr -> Bool
    forall {b}. Expr b -> Expr b -> Bool
    `cheapEqTicked` CoreExpr
    rhs1
        tickss :: [[CoreTickish]]
    tickss = (Alt Var -> [CoreTickish]) -> [Alt Var] -> [[CoreTickish]]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Alt AltCon
    _ [Var]
    _ 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 Var]
    elim_rest

    combineIdenticalAlts [AltCon]
    imposs_cons [Alt Var]
    alts
      = (Bool
    False, [AltCon]
    imposs_cons, [Alt Var]
    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 Var] -> [Alt Var]
    scaleAltsBy Type
    w [Alt Var]
    alts = (Alt Var -> Alt Var) -> [Alt Var] -> [Alt Var]
    forall a b. (a -> b) -> [a] -> [b]
    map Alt Var -> Alt Var
    scaleAlt [Alt Var]
    alts
      where
        scaleAlt :: CoreAlt -> CoreAlt
        scaleAlt :: Alt Var -> Alt Var
    scaleAlt (Alt AltCon
    con [Var]
    bndrs CoreExpr
    rhs) = AltCon -> [Var] -> CoreExpr -> Alt Var
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    con ((Var -> Var) -> [Var] -> [Var]
    forall a b. (a -> b) -> [a] -> [b]
    map Var -> Var
    scaleBndr [Var]
    bndrs) CoreExpr
    rhs

        scaleBndr :: CoreBndr -> CoreBndr
        scaleBndr :: Var -> Var
    scaleBndr Var
    b = Type -> Var -> Var
    scaleVarBy Type
    w Var
    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.
    -}

    exprIsTrivial :: CoreExpr -> Bool
    -- If you modify this function, you may also
    -- need to modify getIdFromTrivialExpr
    exprIsTrivial :: CoreExpr -> Bool
    exprIsTrivial (Var Var
    _)          = Bool
    True        -- See Note [Variables are trivial]
    exprIsTrivial (Type Type
    _)         = Bool
    True
    exprIsTrivial (Coercion CoercionR
    _)     = Bool
    True
    exprIsTrivial (Lit Literal
    lit)        = Literal -> Bool
    litIsTrivial Literal
    lit
    exprIsTrivial (App CoreExpr
    e CoreExpr
    arg)      = Bool -> Bool
    not (CoreExpr -> Bool
    isRuntimeArg CoreExpr
    arg) Bool -> Bool -> Bool
    && CoreExpr -> Bool
    exprIsTrivial CoreExpr
    e
    exprIsTrivial (Lam Var
    b CoreExpr
    e)        = Bool -> Bool
    not (Var -> Bool
    isRuntimeVar Var
    b) Bool -> Bool -> Bool
    && CoreExpr -> Bool
    exprIsTrivial CoreExpr
    e
    exprIsTrivial (Tick CoreTickish
    t CoreExpr
    e)       = Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishIsCode CoreTickish
    t) Bool -> Bool -> Bool
    && CoreExpr -> Bool
    exprIsTrivial CoreExpr
    e
                                     -- See Note [Tick trivial]
    exprIsTrivial (Cast CoreExpr
    e CoercionR
    _)       = CoreExpr -> Bool
    exprIsTrivial CoreExpr
    e
    exprIsTrivial (Case CoreExpr
    e Var
    _ Type
    _ [])  = CoreExpr -> Bool
    exprIsTrivial CoreExpr
    e  -- See Note [Empty case is trivial]
    exprIsTrivial CoreExpr
    _                = Bool
    False

    {-
    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
    getIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Var
    getIdFromTrivialExpr CoreExpr
    e
        = Var -> Maybe Var -> Var
    forall a. a -> Maybe a -> a
    fromMaybe (String -> SDoc -> Var
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "getIdFromTrivialExpr" (CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e))
                    (CoreExpr -> Maybe Var
    getIdFromTrivialExpr_maybe CoreExpr
    e)

    getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
    -- See Note [getIdFromTrivialExpr]
    -- Th equations for this should line up with those for exprIsTrivial
    getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Var
    getIdFromTrivialExpr_maybe CoreExpr
    e
      = CoreExpr -> Maybe Var
    go CoreExpr
    e
      where
        go :: CoreExpr -> Maybe Var
    go (App CoreExpr
    f CoreExpr
    t) | Bool -> Bool
    not (CoreExpr -> Bool
    isRuntimeArg CoreExpr
    t)   = CoreExpr -> Maybe Var
    go CoreExpr
    f
        go (Tick CoreTickish
    t CoreExpr
    e) | Bool -> Bool
    not (CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishIsCode CoreTickish
    t) = CoreExpr -> Maybe Var
    go CoreExpr
    e
        go (Cast CoreExpr
    e CoercionR
    _)                         = CoreExpr -> Maybe Var
    go CoreExpr
    e
        go (Lam Var
    b CoreExpr
    e) | Bool -> Bool
    not (Var -> Bool
    isRuntimeVar Var
    b)   = CoreExpr -> Maybe Var
    go CoreExpr
    e
        go (Case CoreExpr
    e Var
    _ Type
    _ [])                    = CoreExpr -> Maybe Var
    go CoreExpr
    e
        go (Var Var
    v) = Var -> Maybe Var
    forall a. a -> Maybe a
    Just Var
    v
        go CoreExpr
    _       = Maybe Var
    forall a. Maybe a
    Nothing

    {-
    exprIsDeadEnd is a very cheap and cheerful function; it may return
    False for bottoming expressions, but it never costs much to ask.  See
    also GHC.Core.Opt.Arity.exprBotStrictness_maybe, but that's a bit more
    expensive.
    -}

    exprIsDeadEnd :: CoreExpr -> Bool
    -- See Note [Bottoming expressions]
    exprIsDeadEnd :: CoreExpr -> Bool
    exprIsDeadEnd CoreExpr
    e
      | Type -> Bool
    isEmptyTy (CoreExpr -> Type
    exprType CoreExpr
    e)
      = Bool
    True
      | Bool
    otherwise
      = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    0 CoreExpr
    e
      where
        go :: FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n (Var Var
    v)                 = Var -> Bool
    isDeadEndId Var
    v Bool -> Bool -> Bool
    &&  FullArgCount
    n FullArgCount -> FullArgCount -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Var -> FullArgCount
    idArity Var
    v
        go FullArgCount
    n (App CoreExpr
    e CoreExpr
    a) | CoreExpr -> Bool
    forall b. Expr b -> Bool
    isTypeArg CoreExpr
    a = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    e
                       | Bool
    otherwise   = FullArgCount -> CoreExpr -> Bool
    go (FullArgCount
    nFullArgCount -> FullArgCount -> FullArgCount
    forall a. Num a => a -> a -> a
    +FullArgCount
    1) CoreExpr
    e
        go FullArgCount
    n (Tick CoreTickish
    _ CoreExpr
    e)              = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    e
        go FullArgCount
    n (Cast CoreExpr
    e CoercionR
    _)              = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    e
        go FullArgCount
    n (Let Bind Var
    _ CoreExpr
    e)               = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    e
        go FullArgCount
    n (Lam Var
    v CoreExpr
    e) | Var -> Bool
    isTyVar Var
    v   = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    e
        go FullArgCount
    _ (Case CoreExpr
    _ Var
    _ Type
    _ [Alt Var]
    alts)       = [Alt Var] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Var]
    alts
           -- See Note [Empty case alternatives] in GHC.Core
        go FullArgCount
    _ CoreExpr
    _                       = Bool
    False

    {- Note [Bottoming expressions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    A bottoming expression is guaranteed to diverge, or raise an
    exception.  We can test for it in two different ways, and exprIsDeadEnd
    checks for both of these situations:

    * Visibly-bottom computations.  For example
          (error Int "Hello")
      is visibly bottom.  The strictness analyser also finds out if
      a function diverges or raises an exception, and puts that info
      in its strictness signature.

    * Empty types.  If a type is empty, its only inhabitant is bottom.
      For example:
          data T
          f :: T -> Bool
          f = \(x:t). case x of Bool {}
      Since T has no data constructors, the case alternatives are of course
      empty.  However note that 'x' is not bound to a visibly-bottom value;
      it's the *type* that tells us it's going to diverge.

    A GADT may also be empty even though it has constructors:
            data T a where
              T1 :: a -> T Bool
              T2 :: T Int
            ...(case (x::T Char) of {})...
    Here (T Char) is uninhabited.  A more realistic case is (Int ~ Bool),
    which is likewise uninhabited.

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

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

    dupAppSize :: Int
    dupAppSize :: FullArgCount
    dupAppSize = FullArgCount
    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 exprIsCheap 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 = CheapAppFun -> CoreExpr -> Bool
    exprIsCheapX CheapAppFun
    isWorkFreeApp

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

    exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool
    exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool
    exprIsCheapX CheapAppFun
    ok_app CoreExpr
    e
      = CoreExpr -> Bool
    ok CoreExpr
    e
      where
        ok :: CoreExpr -> Bool
    ok CoreExpr
    e = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    0 CoreExpr
    e

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

        -- n is the number of value arguments
        go :: FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n (Var Var
    v)                      = CheapAppFun
    isExpandableApp Var
    v FullArgCount
    n
        go FullArgCount
    _ (Lit {})                     = Bool
    True
        go FullArgCount
    _ (Type {})                    = Bool
    True
        go FullArgCount
    _ (Coercion {})                = Bool
    True
        go FullArgCount
    n (Cast CoreExpr
    e CoercionR
    _)                   = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    e
        go FullArgCount
    n (Tick CoreTickish
    t CoreExpr
    e) | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    t = Bool
    False
                        | Bool
    otherwise       = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    e
        go FullArgCount
    n (Lam Var
    x CoreExpr
    e)  | Var -> Bool
    isRuntimeVar Var
    x  = FullArgCount
    nFullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FullArgCount
    0 Bool -> Bool -> Bool
    || FullArgCount -> CoreExpr -> Bool
    go (FullArgCount
    nFullArgCount -> FullArgCount -> FullArgCount
    forall a. Num a => a -> a -> a
    -FullArgCount
    1) CoreExpr
    e
                        | Bool
    otherwise       = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    e
        go FullArgCount
    n (App CoreExpr
    f CoreExpr
    e)  | CoreExpr -> Bool
    isRuntimeArg CoreExpr
    e  = FullArgCount -> CoreExpr -> Bool
    go (FullArgCount
    nFullArgCount -> FullArgCount -> FullArgCount
    forall a. Num a => a -> a -> a
    +FullArgCount
    1) CoreExpr
    f Bool -> Bool -> Bool
    && CoreExpr -> Bool
    ok CoreExpr
    e
                        | Bool
    otherwise       = FullArgCount -> CoreExpr -> Bool
    go FullArgCount
    n CoreExpr
    f
        go FullArgCount
    _ (Case {})                    = Bool
    False
        go FullArgCount
    _ (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 Var
    fn FullArgCount
    n_val_args
      | FullArgCount
    n_val_args FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == FullArgCount
    0           -- No value args
      = Bool
    True
      | FullArgCount
    n_val_args FullArgCount -> FullArgCount -> Bool
    forall a. Ord a => a -> a -> Bool
    < Var -> FullArgCount
    idArity Var
    fn   -- Partial application
      = Bool
    True
      | Bool
    otherwise
      = case Var -> IdDetails
    idDetails Var
    fn of
          DataConWorkId {} -> Bool
    True
          IdDetails
    _                -> Bool
    False

    isCheapApp :: CheapAppFun
    isCheapApp :: CheapAppFun
    isCheapApp Var
    fn FullArgCount
    n_val_args
      | CheapAppFun
    isWorkFreeApp Var
    fn FullArgCount
    n_val_args = Bool
    True
      | Var -> Bool
    isDeadEndId Var
    fn              = Bool
    True  -- See Note [isCheapApp: bottoming functions]
      | Bool
    otherwise
      = case Var -> IdDetails
    idDetails Var
    fn of
          DataConWorkId {} -> Bool
    True  -- Actually handled by isWorkFreeApp
          RecSelId {}      -> FullArgCount
    n_val_args FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == FullArgCount
    1  -- See Note [Record selection]
          ClassOpId {}     -> FullArgCount
    n_val_args FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == FullArgCount
    1
          PrimOpId PrimOp
    op      -> 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 Var
    fn FullArgCount
    n_val_args
      | CheapAppFun
    isWorkFreeApp Var
    fn FullArgCount
    n_val_args = Bool
    True
      | Bool
    otherwise
      = case Var -> IdDetails
    idDetails Var
    fn of
          RecSelId {}  -> FullArgCount
    n_val_args FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == FullArgCount
    1  -- See Note [Record selection]
          ClassOpId {} -> FullArgCount
    n_val_args FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == FullArgCount
    1
          PrimOpId {}  -> Bool
    False
          IdDetails
    _ | Var -> Bool
    isDeadEndId Var
    fn     -> Bool
    False
              -- See Note [isExpandableApp: bottoming functions]
            | Var -> Bool
    isConLikeId Var
    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 = FullArgCount -> Type -> Bool
    forall {t}. (Eq t, Num t) => t -> Type -> Bool
    all_pred_args FullArgCount
    n_val_args (Var -> Type
    idType Var
    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 (TyCoBinder
    bndr, Type
    ty) <- Type -> Maybe (TyCoBinder, Type)
    splitPiTy_maybe Type
    ty
           = case TyCoBinder
    bndr of
               Named {}        -> t -> Type -> Bool
    all_pred_args t
    n_val_args Type
    ty
               Anon AnonArgFlag
    InvisArg Scaled Type
    _ -> t -> Type -> Bool
    all_pred_args (t
    n_val_argst -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) Type
    ty
               Anon AnonArgFlag
    VisArg Scaled Type
    _   -> Bool
    False

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

    -----------------------------
    -- | 'exprOkForSpeculation' returns True of an expression that is:
    --
    --  * Safe to evaluate even if normal order eval might not
    --    evaluate the expression at all, or
    --
    --  * Safe /not/ to evaluate even if normal order would do so
    --
    -- It is usually called on arguments of unlifted type, but not always
    -- In particular, Simplify.rebuildCase calls it on lifted types
    -- when a 'case' is a plain 'seq'. See the example in
    -- Note [exprOkForSpeculation: case expressions] below
    --
    -- Precisely, it returns @True@ iff:
    --  a) The expression guarantees to terminate,
    --  b) soon,
    --  c) without causing a write side effect (e.g. writing a mutable variable)
    --  d) without throwing a Haskell exception
    --  e) without risking an unchecked runtime exception (array out of bounds,
    --     divide by zero)
    --
    -- For @exprOkForSideEffects@ the list is the same, but omitting (e).
    --
    -- Note that
    --    exprIsHNF            implies exprOkForSpeculation
    --    exprOkForSpeculation implies exprOkForSideEffects
    --
    -- See Note [PrimOp can_fail and has_side_effects] in "GHC.Builtin.PrimOps"
    -- and Note [Transformations affected by can_fail and has_side_effects]
    --
    -- 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.

    exprOkForSpeculation, exprOkForSideEffects :: CoreExpr -> Bool
    exprOkForSpeculation :: CoreExpr -> Bool
    exprOkForSpeculation = (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok PrimOp -> Bool
    primOpOkForSpeculation
    exprOkForSideEffects :: CoreExpr -> Bool
    exprOkForSideEffects = (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok PrimOp -> Bool
    primOpOkForSideEffects

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

    expr_ok PrimOp -> Bool
    primop_ok (Var Var
    v)    = (PrimOp -> Bool) -> Var -> [CoreExpr] -> Bool
    app_ok PrimOp -> Bool
    primop_ok Var
    v []
    expr_ok PrimOp -> Bool
    primop_ok (Cast CoreExpr
    e CoercionR
    _) = (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok PrimOp -> Bool
    primop_ok CoreExpr
    e
    expr_ok PrimOp -> Bool
    primop_ok (Lam Var
    b CoreExpr
    e)
                     | Var -> Bool
    isTyVar Var
    b = (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_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 PrimOp -> Bool
    primop_ok (Tick CoreTickish
    tickish CoreExpr
    e)
       | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishCounts CoreTickish
    tickish = Bool
    False
       | Bool
    otherwise             = (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok PrimOp -> Bool
    primop_ok CoreExpr
    e

    expr_ok PrimOp -> Bool
    _ (Let {}) = Bool
    False
      -- Lets can be stacked deeply, so just give up.
      -- In any case, the argument of exprOkForSpeculation is
      -- usually in a strict context, so any lets will have been
      -- floated away.

    expr_ok PrimOp -> Bool
    primop_ok (Case CoreExpr
    scrut Var
    bndr Type
    _ [Alt Var]
    alts)
      =  -- See Note [exprOkForSpeculation: case expressions]
         (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok PrimOp -> Bool
    primop_ok CoreExpr
    scrut
      Bool -> Bool -> Bool
    && HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType (Var -> Type
    idType Var
    bndr)
      Bool -> Bool -> Bool
    && (Alt Var -> Bool) -> [Alt Var] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\(Alt AltCon
    _ [Var]
    _ CoreExpr
    rhs) -> (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok PrimOp -> Bool
    primop_ok CoreExpr
    rhs) [Alt Var]
    alts
      Bool -> Bool -> Bool
    && [Alt Var] -> Bool
    forall b. [Alt b] -> Bool
    altsAreExhaustive [Alt Var]
    alts

    expr_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 Var
    f   -> (PrimOp -> Bool) -> Var -> [CoreExpr] -> Bool
    app_ok PrimOp -> Bool
    primop_ok Var
    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).
            Lit Literal
    lit -> ASSERT( isRubbishLit lit ) True
            CoreExpr
    _       -> Bool
    False

    -----------------------------
    app_ok :: (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool
    app_ok :: (PrimOp -> Bool) -> Var -> [CoreExpr] -> Bool
    app_ok PrimOp -> Bool
    primop_ok Var
    fun [CoreExpr]
    args
      = case Var -> IdDetails
    idDetails Var
    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
    True
                    -- The strictness of the constructor has already
                    -- been expressed by its "wrapper", so we don't need
                    -- to take the arguments into account

          PrimOpId PrimOp
    op
            | PrimOp -> Bool
    primOpIsDiv PrimOp
    op
            , [CoreExpr
    arg1, Lit Literal
    lit] <- [CoreExpr]
    args
            -> Bool -> Bool
    not (Literal -> Bool
    isZeroLit Literal
    lit) Bool -> Bool -> Bool
    && (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok PrimOp -> Bool
    primop_ok CoreExpr
    arg1
                  -- 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

            | PrimOp
    SeqOp <- PrimOp
    op  -- See Note [exprOkForSpeculation and SeqOp/DataToTagOp]
            -> Bool
    False       --     for the special cases for SeqOp and DataToTagOp
            | PrimOp
    DataToTagOp <- PrimOp
    op
            -> Bool
    False
            | PrimOp
    KeepAliveOp <- PrimOp
    op
            -> Bool
    False

            | Bool
    otherwise
            -> PrimOp -> Bool
    primop_ok PrimOp
    op  -- Check the primop itself
            Bool -> Bool -> Bool
    && [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ((TyCoBinder -> CoreExpr -> Bool)
    -> [TyCoBinder] -> [CoreExpr] -> [Bool]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith TyCoBinder -> CoreExpr -> Bool
    primop_arg_ok [TyCoBinder]
    arg_tys [CoreExpr]
    args)  -- Check the arguments

          IdDetails
    _other -> HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType (Var -> Type
    idType Var
    fun)          -- c.f. the Var case of exprIsHNF
                 Bool -> Bool -> Bool
    || Var -> FullArgCount
    idArity Var
    fun FullArgCount -> FullArgCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > FullArgCount
    n_val_args             -- Partial apps
                 -- NB: even in the nullary case, do /not/ check
                 --     for evaluated-ness of the fun;
                 --     see Note [exprOkForSpeculation and evaluated variables]
                 where
                   n_val_args :: FullArgCount
    n_val_args = [CoreExpr] -> FullArgCount
    forall b. [Arg b] -> FullArgCount
    valArgCount [CoreExpr]
    args
      where
        ([TyCoBinder]
    arg_tys, Type
    _) = Type -> ([TyCoBinder], Type)
    splitPiTys (Var -> Type
    idType Var
    fun)

        primop_arg_ok :: TyBinder -> CoreExpr -> Bool
        primop_arg_ok :: TyCoBinder -> CoreExpr -> Bool
    primop_arg_ok (Named TyCoVarBinder
    _) CoreExpr
    _ = Bool
    True   -- A type argument
        primop_arg_ok (Anon AnonArgFlag
    _ Scaled Type
    ty) CoreExpr
    arg      -- A term argument
           | HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType (Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing Scaled Type
    ty) = (PrimOp -> Bool) -> CoreExpr -> Bool
    expr_ok PrimOp -> Bool
    primop_ok CoreExpr
    arg
           | Bool
    otherwise         = Bool
    True  -- See Note [Primops with lifted arguments]

    -----------------------------
    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
    False    -- Should not happen
    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] -> FullArgCount -> Bool
    forall a. [a] -> FullArgCount -> Bool
    `lengthIs` (TyCon -> FullArgCount
    tyConFamilySize (DataCon -> TyCon
    dataConTyCon DataCon
    c) FullArgCount -> FullArgCount -> FullArgCount
    forall a. Num a => a -> a -> a
    - FullArgCount
    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

    {- 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/app 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/app 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 [Primops with lifted arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Is this ok-for-speculation (see #13027)?
       reallyUnsafePtrEq# a b
    Well, yes.  The primop accepts lifted arguments and does not
    evaluate them.  Indeed, in general primops are, well, primitive
    and do not perform evaluation.

    Bottom line:
      * In exprOkForSpeculation we simply ignore all lifted arguments.
      * In the rare case of primops that /do/ evaluate their arguments,
        (namely DataToTagOp and SeqOp) return False; see
        Note [exprOkForSpeculation and evaluated variables]

    Note [exprOkForSpeculation and SeqOp/DataToTagOp]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Most primops with lifted arguments don't evaluate them
    (see Note [Primops with lifted arguments]), so we can ignore
    that argument entirely when doing exprOkForSpeculation.

    But DataToTagOp and SeqOp are exceptions to that rule.
    For reasons described in Note [exprOkForSpeculation and
    evaluated variables], we simply return False for them.

    Not doing this made #5129 go bad.
    Lots of discussion in #15696.

    Note [exprOkForSpeculation and evaluated variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Recall that
      seq#       :: forall a s. a -> State# s -> (# State# s, a #)
      dataToTag# :: forall a.   a -> Int#
    must always evaluate their first argument.

    Now consider these examples:
     * case x of y { DEFAULT -> ....y.... }
       Should 'y' (alone) be considered ok-for-speculation?

     * case x of y { DEFAULT -> ....f (dataToTag# y)... }
       Should (dataToTag# y) be considered ok-for-spec?

    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 -> ....f (dataToTag# x)... }

    And now the expression does not obey the let/app invariant!  Yikes!
    Moreover we really might float (f (dataToTag# x)) outside the case,
    and then it really, really doesn't obey the let/app 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 DataToTagOp and SeqOp.

    Note that exprIsHNF /can/ and does take advantage of evaluated-ness;
    it doesn't have the trickiness of the let/app 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 change:
    --
    -- > case x of _ -> e
    --
    --    into:
    --
    -- > e
    --
    -- and to decide whether it's safe to discard a 'seq'.
    --
    -- 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. However this can't
    -- happen: see "GHC.Core#let_app_invariant". This invariant states that arguments of
    -- unboxed type must be ok-for-speculation (or trivial).
    exprIsHNF :: CoreExpr -> Bool           -- True => Value-lambda, constructor, PAP
    exprIsHNF :: CoreExpr -> Bool
    exprIsHNF = (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    exprIsHNFlike Var -> 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 = (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    exprIsHNFlike Var -> 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 :: (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    exprIsHNFlike :: (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    exprIsHNFlike Var -> Bool
    is_con Unfolding -> Bool
    is_con_unf = CoreExpr -> Bool
    is_hnf_like
      where
        is_hnf_like :: CoreExpr -> Bool
    is_hnf_like (Var Var
    v) -- NB: There are no value args at this point
          =  CheapAppFun
    id_app_is_value Var
    v FullArgCount
    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 (Var -> Unfolding
    idUnfolding Var
    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

        is_hnf_like (Lit Literal
    _)          = Bool
    True
        is_hnf_like (Type Type
    _)         = Bool
    True       -- Types are honorary Values;
                                                  -- we don't mind copying them
        is_hnf_like (Coercion CoercionR
    _)     = Bool
    True       -- Same for coercions
        is_hnf_like (Lam Var
    b CoreExpr
    e)        = Var -> Bool
    isRuntimeVar Var
    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 CoercionR
    _)       = 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 -> FullArgCount -> Bool
    app_is_value CoreExpr
    e FullArgCount
    1
          | Bool
    otherwise                = CoreExpr -> Bool
    is_hnf_like CoreExpr
    e
        is_hnf_like (Let Bind Var
    _ CoreExpr
    e)        = CoreExpr -> Bool
    is_hnf_like CoreExpr
    e  -- Lazy let(rec)s don't affect us
        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 -> FullArgCount -> Bool
    app_is_value (Var Var
    f)    FullArgCount
    nva = CheapAppFun
    id_app_is_value Var
    f FullArgCount
    nva
        app_is_value (Tick CoreTickish
    _ CoreExpr
    f) FullArgCount
    nva = CoreExpr -> FullArgCount -> Bool
    app_is_value CoreExpr
    f FullArgCount
    nva
        app_is_value (Cast CoreExpr
    f CoercionR
    _) FullArgCount
    nva = CoreExpr -> FullArgCount -> Bool
    app_is_value CoreExpr
    f FullArgCount
    nva
        app_is_value (App CoreExpr
    f CoreExpr
    a)  FullArgCount
    nva
          | CoreExpr -> Bool
    forall b. Expr b -> Bool
    isValArg CoreExpr
    a              = CoreExpr -> FullArgCount -> Bool
    app_is_value CoreExpr
    f (FullArgCount
    nva FullArgCount -> FullArgCount -> FullArgCount
    forall a. Num a => a -> a -> a
    + FullArgCount
    1)
          | Bool
    otherwise               = CoreExpr -> FullArgCount -> Bool
    app_is_value CoreExpr
    f FullArgCount
    nva
        app_is_value CoreExpr
    _          FullArgCount
    _   = Bool
    False

        id_app_is_value :: CheapAppFun
    id_app_is_value Var
    id FullArgCount
    n_val_args
           = Var -> Bool
    is_con Var
    id
           Bool -> Bool -> Bool
    || Var -> FullArgCount
    idArity Var
    id FullArgCount -> FullArgCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > FullArgCount
    n_val_args
           Bool -> Bool -> Bool
    || Var
    id Var -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    absentErrorIdKey  -- See Note [aBSENT_ERROR_ID] in GHC.Core.Make
                          -- absentError behaves like an honorary data constructor

    {-
    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 be levity polymorphic 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] -> ([Var], [Var])
    dataConRepInstPat   = [FastString]
    -> [Unique] -> Type -> DataCon -> [Type] -> ([Var], [Var])
    dataConInstPat (FastString -> [FastString]
    forall a. a -> [a]
    repeat ((String -> FastString
    fsLit String
    "ipv")))
    dataConRepFSInstPat :: [FastString]
    -> [Unique] -> Type -> DataCon -> [Type] -> ([Var], [Var])
    dataConRepFSInstPat = [FastString]
    -> [Unique] -> Type -> DataCon -> [Type] -> ([Var], [Var])
    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 indended 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] -> ([Var], [Var])
    dataConInstPat [FastString]
    fss [Unique]
    uniqs Type
    mult DataCon
    con [Type]
    inst_tys
      = ASSERT( univ_tvs `equalLength` inst_tys )
        ([Var]
    ex_bndrs, [Var]
    arg_ids)
      where
        univ_tvs :: [Var]
    univ_tvs = DataCon -> [Var]
    dataConUnivTyVars DataCon
    con
        ex_tvs :: [Var]
    ex_tvs   = DataCon -> [Var]
    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 :: FullArgCount
    n_ex = [Var] -> FullArgCount
    forall (t :: * -> *) a. Foldable t => t a -> FullArgCount
    length [Var]
    ex_tvs

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

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

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

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

          -- Make value vars, instantiating types
        arg_ids :: [Var]
    arg_ids = (Unique -> FastString -> Scaled Type -> StrictnessMark -> Var)
    -> [Unique]
    -> [FastString]
    -> [Scaled Type]
    -> [StrictnessMark]
    -> [Var]
    forall a b c d e.
    (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
    zipWith4 Unique -> FastString -> Scaled Type -> StrictnessMark -> Var
    mk_id_var [Unique]
    id_uniqs [FastString]
    id_fss [Scaled Type]
    arg_tys [StrictnessMark]
    arg_strs
        mk_id_var :: Unique -> FastString -> Scaled Type -> StrictnessMark -> Var
    mk_id_var Unique
    uniq FastString
    fs (Scaled Type
    m Type
    ty) StrictnessMark
    str
          = StrictnessMark -> Var -> Var
    setCaseBndrEvald StrictnessMark
    str (Var -> Var) -> Var -> Var
    forall a b. (a -> b) -> a -> b
    $  -- See Note [Mark evaluated arguments]
            Name -> Type -> Type -> Var
    mkLocalIdOrCoVar Name
    name (Type
    mult Type -> Type -> Type
    `mkMultMul` Type
    m) (HasCallStack => TCvSubst -> Type -> Type
    TCvSubst -> Type -> Type
    Type.substTy TCvSubst
    full_subst Type
    ty)
          where
            name :: Name
    name = Unique -> OccName -> SrcSpan -> Name
    mkInternalName Unique
    uniq (FastString -> OccName
    mkVarOccFS FastString
    fs) 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 Var
    v1)   (Var Var
    v2)         = Var
    v1 Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    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 Type -> Type -> Bool
    `eqType` Type
    t2
        go (Coercion CoercionR
    c1) (Coercion CoercionR
    c2) = CoercionR
    c1 CoercionR -> CoercionR -> Bool
    `eqCoercion` CoercionR
    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 CoercionR
    t1) (Cast Expr b
    e2 CoercionR
    t2)   = Expr b
    e1 Expr b -> Expr b -> Bool
    `go` Expr b
    e2 Bool -> Bool -> Bool
    && CoercionR
    t1 CoercionR -> CoercionR -> Bool
    `eqCoercion` CoercionR
    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

    eqExpr :: InScopeSet -> CoreExpr -> CoreExpr -> Bool
    -- Compares for equality, modulo alpha
    eqExpr :: InScopeSet -> CoreExpr -> CoreExpr -> Bool
    eqExpr InScopeSet
    in_scope CoreExpr
    e1 CoreExpr
    e2
      = RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go (InScopeSet -> RnEnv2
    mkRnEnv2 InScopeSet
    in_scope) CoreExpr
    e1 CoreExpr
    e2
      where
        go :: RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env (Var Var
    v1) (Var Var
    v2)
          | RnEnv2 -> Var -> Var
    rnOccL RnEnv2
    env Var
    v1 Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == RnEnv2 -> Var -> Var
    rnOccR RnEnv2
    env Var
    v2
          = Bool
    True

        go RnEnv2
    _   (Lit Literal
    lit1)    (Lit Literal
    lit2)      = Literal
    lit1 Literal -> Literal -> Bool
    forall a. Eq a => a -> a -> Bool
    == Literal
    lit2
        go RnEnv2
    env (Type Type
    t1)    (Type Type
    t2)        = RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2
        go RnEnv2
    env (Coercion CoercionR
    co1) (Coercion CoercionR
    co2) = RnEnv2 -> CoercionR -> CoercionR -> Bool
    eqCoercionX RnEnv2
    env CoercionR
    co1 CoercionR
    co2
        go RnEnv2
    env (Cast CoreExpr
    e1 CoercionR
    co1) (Cast CoreExpr
    e2 CoercionR
    co2) = RnEnv2 -> CoercionR -> CoercionR -> Bool
    eqCoercionX RnEnv2
    env CoercionR
    co1 CoercionR
    co2 Bool -> Bool -> Bool
    && RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2
        go RnEnv2
    env (App CoreExpr
    f1 CoreExpr
    a1)   (App CoreExpr
    f2 CoreExpr
    a2)   = RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env CoreExpr
    f1 CoreExpr
    f2 Bool -> Bool -> Bool
    && RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env CoreExpr
    a1 CoreExpr
    a2
        go RnEnv2
    env (Tick CoreTickish
    n1 CoreExpr
    e1)  (Tick CoreTickish
    n2 CoreExpr
    e2)  = RnEnv2 -> CoreTickish -> CoreTickish -> Bool
    eqTickish RnEnv2
    env CoreTickish
    n1 CoreTickish
    n2 Bool -> Bool -> Bool
    && RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2

        go RnEnv2
    env (Lam Var
    b1 CoreExpr
    e1)  (Lam Var
    b2 CoreExpr
    e2)
          =  RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env (Var -> Type
    varType Var
    b1) (Var -> Type
    varType Var
    b2)   -- False for Id/TyVar combination
          Bool -> Bool -> Bool
    && RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go (RnEnv2 -> Var -> Var -> RnEnv2
    rnBndr2 RnEnv2
    env Var
    b1 Var
    b2) CoreExpr
    e1 CoreExpr
    e2

        go RnEnv2
    env (Let (NonRec Var
    v1 CoreExpr
    r1) CoreExpr
    e1) (Let (NonRec Var
    v2 CoreExpr
    r2) CoreExpr
    e2)
          =  RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env CoreExpr
    r1 CoreExpr
    r2  -- No need to check binder types, since RHSs match
          Bool -> Bool -> Bool
    && RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go (RnEnv2 -> Var -> Var -> RnEnv2
    rnBndr2 RnEnv2
    env Var
    v1 Var
    v2) CoreExpr
    e1 CoreExpr
    e2

        go RnEnv2
    env (Let (Rec [(Var, CoreExpr)]
    ps1) CoreExpr
    e1) (Let (Rec [(Var, CoreExpr)]
    ps2) CoreExpr
    e2)
          = [(Var, CoreExpr)] -> [(Var, CoreExpr)] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [(Var, CoreExpr)]
    ps1 [(Var, CoreExpr)]
    ps2
          Bool -> Bool -> Bool
    && (CoreExpr -> CoreExpr -> Bool) -> [CoreExpr] -> [CoreExpr] -> Bool
    forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
    all2 (RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env') [CoreExpr]
    rs1 [CoreExpr]
    rs2 Bool -> Bool -> Bool
    && RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env' CoreExpr
    e1 CoreExpr
    e2
          where
            ([Var]
    bs1,[CoreExpr]
    rs1) = [(Var, CoreExpr)] -> ([Var], [CoreExpr])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Var, CoreExpr)]
    ps1
            ([Var]
    bs2,[CoreExpr]
    rs2) = [(Var, CoreExpr)] -> ([Var], [CoreExpr])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Var, CoreExpr)]
    ps2
            env' :: RnEnv2
    env' = RnEnv2 -> [Var] -> [Var] -> RnEnv2
    rnBndrs2 RnEnv2
    env [Var]
    bs1 [Var]
    bs2

        go RnEnv2
    env (Case CoreExpr
    e1 Var
    b1 Type
    t1 [Alt Var]
    a1) (Case CoreExpr
    e2 Var
    b2 Type
    t2 [Alt Var]
    a2)
          | [Alt Var] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Var]
    a1   -- See Note [Empty case alternatives] in GHC.Data.TrieMap
          = [Alt Var] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Var]
    a2 Bool -> Bool -> Bool
    && RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2 Bool -> Bool -> Bool
    && RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2
          | Bool
    otherwise
          =  RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go RnEnv2
    env CoreExpr
    e1 CoreExpr
    e2 Bool -> Bool -> Bool
    && (Alt Var -> Alt Var -> Bool) -> [Alt Var] -> [Alt Var] -> Bool
    forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
    all2 (RnEnv2 -> Alt Var -> Alt Var -> Bool
    go_alt (RnEnv2 -> Var -> Var -> RnEnv2
    rnBndr2 RnEnv2
    env Var
    b1 Var
    b2)) [Alt Var]
    a1 [Alt Var]
    a2

        go RnEnv2
    _ CoreExpr
    _ CoreExpr
    _ = Bool
    False

        -----------
        go_alt :: RnEnv2 -> Alt Var -> Alt Var -> Bool
    go_alt RnEnv2
    env (Alt AltCon
    c1 [Var]
    bs1 CoreExpr
    e1) (Alt AltCon
    c2 [Var]
    bs2 CoreExpr
    e2)
          = AltCon
    c1 AltCon -> AltCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == AltCon
    c2 Bool -> Bool -> Bool
    && RnEnv2 -> CoreExpr -> CoreExpr -> Bool
    go (RnEnv2 -> [Var] -> [Var] -> RnEnv2
    rnBndrs2 RnEnv2
    env [Var]
    bs1 [Var]
    bs2) CoreExpr
    e1 CoreExpr
    e2

    eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool
    eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool
    eqTickish RnEnv2
    env (Breakpoint XBreakpoint 'TickishPassCore
    lext FullArgCount
    lid [XTickishId 'TickishPassCore]
    lids) (Breakpoint XBreakpoint 'TickishPassCore
    rext FullArgCount
    rid [XTickishId 'TickishPassCore]
    rids)
          = FullArgCount
    lid FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == FullArgCount
    rid Bool -> Bool -> Bool
    &&
            (Var -> Var) -> [Var] -> [Var]
    forall a b. (a -> b) -> [a] -> [b]
    map (RnEnv2 -> Var -> Var
    rnOccL RnEnv2
    env) [Var]
    [XTickishId 'TickishPassCore]
    lids [Var] -> [Var] -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Var -> Var) -> [Var] -> [Var]
    forall a b. (a -> b) -> [a] -> [b]
    map (RnEnv2 -> Var -> Var
    rnOccR RnEnv2
    env) [Var]
    [XTickishId 'TickishPassCore]
    rids Bool -> Bool -> Bool
    &&
            NoExtField
    XBreakpoint 'TickishPassCore
    lext NoExtField -> NoExtField -> Bool
    forall a. Eq a => a -> a -> Bool
    == NoExtField
    XBreakpoint 'TickishPassCore
    rext
    eqTickish RnEnv2
    _ CoreTickish
    l CoreTickish
    r = CoreTickish
    l CoreTickish -> CoreTickish -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoreTickish
    r

    -- | 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 Var
    v1)   (Var Var
    v2)   | RnEnv2 -> Var -> Var
    rnOccL RnEnv2
    env Var
    v1 Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == RnEnv2 -> Var -> Var
    rnOccR RnEnv2
    env Var
    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)  | RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2              = []
    diffExpr Bool
    _   RnEnv2
    env (Coercion CoercionR
    co1) (Coercion CoercionR
    co2)
                                           | RnEnv2 -> CoercionR -> CoercionR -> Bool
    eqCoercionX RnEnv2
    env CoercionR
    co1 CoercionR
    co2        = []
    diffExpr Bool
    top RnEnv2
    env (Cast CoreExpr
    e1 CoercionR
    co1)  (Cast CoreExpr
    e2 CoercionR
    co2)
      | RnEnv2 -> CoercionR -> CoercionR -> Bool
    eqCoercionX RnEnv2
    env CoercionR
    co1 CoercionR
    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 Var
    absent) CoreExpr
    _) CoreExpr
    _)
                     (App (App (Var Var
    absent2) CoreExpr
    _) CoreExpr
    _)
      | Var -> Bool
    isDeadEndId Var
    absent Bool -> Bool -> Bool
    && Var -> Bool
    isDeadEndId Var
    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 Var
    b1 CoreExpr
    e1)  (Lam Var
    b2 CoreExpr
    e2)
      | RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env (Var -> Type
    varType Var
    b1) (Var -> Type
    varType Var
    b2)   -- False for Id/TyVar combination
      = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top (RnEnv2 -> Var -> Var -> RnEnv2
    rnBndr2 RnEnv2
    env Var
    b1 Var
    b2) CoreExpr
    e1 CoreExpr
    e2
    diffExpr Bool
    top RnEnv2
    env (Let Bind Var
    bs1 CoreExpr
    e1) (Let Bind Var
    bs2 CoreExpr
    e2)
      = let ([SDoc]
    ds, RnEnv2
    env') = Bool
    -> RnEnv2
    -> [(Var, CoreExpr)]
    -> [(Var, CoreExpr)]
    -> ([SDoc], RnEnv2)
    diffBinds Bool
    top RnEnv2
    env ([Bind Var] -> [(Var, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds [Bind Var
    bs1]) ([Bind Var] -> [(Var, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds [Bind Var
    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 Var
    b1 Type
    t1 [Alt Var]
    a1) (Case CoreExpr
    e2 Var
    b2 Type
    t2 [Alt Var]
    a2)
      | [Alt Var] -> [Alt Var] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [Alt Var]
    a1 [Alt Var]
    a2 Bool -> Bool -> Bool
    && Bool -> Bool
    not ([Alt Var] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Alt Var]
    a1) Bool -> Bool -> 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 Var -> Alt Var -> [SDoc])
    -> [Alt Var] -> [Alt Var] -> [[SDoc]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Alt Var -> Alt Var -> [SDoc]
    diffAlt [Alt Var]
    a1 [Alt Var]
    a2)
      where env' :: RnEnv2
    env' = RnEnv2 -> Var -> Var -> RnEnv2
    rnBndr2 RnEnv2
    env Var
    b1 Var
    b2
            diffAlt :: Alt Var -> Alt Var -> [SDoc]
    diffAlt (Alt AltCon
    c1 [Var]
    bs1 CoreExpr
    e1) (Alt AltCon
    c2 [Var]
    bs2 CoreExpr
    e2)
              | AltCon
    c1 AltCon -> AltCon -> Bool
    forall a. Eq a => a -> a -> Bool
    /= AltCon
    c2  = [String -> SDoc
    text String
    "alt-cons " SDoc -> SDoc -> SDoc
    <> AltCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltCon
    c1 SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    " /= " SDoc -> SDoc -> SDoc
    <> AltCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltCon
    c2]
              | Bool
    otherwise = Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top (RnEnv2 -> [Var] -> [Var] -> RnEnv2
    rnBndrs2 RnEnv2
    env' [Var]
    bs1 [Var]
    bs2) CoreExpr
    e1 CoreExpr
    e2
    diffExpr Bool
    _  RnEnv2
    _ CoreExpr
    e1 CoreExpr
    e2
      = [[SDoc] -> SDoc
    fsep [CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e1, String -> SDoc
    text String
    "/=", CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e2]]

    -- | 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.
    diffBinds :: Bool -> RnEnv2 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
              -> ([SDoc], RnEnv2)
    diffBinds :: Bool
    -> RnEnv2
    -> [(Var, CoreExpr)]
    -> [(Var, CoreExpr)]
    -> ([SDoc], RnEnv2)
    diffBinds Bool
    top RnEnv2
    env [(Var, CoreExpr)]
    binds1 = FullArgCount
    -> RnEnv2
    -> [(Var, CoreExpr)]
    -> [(Var, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go ([(Var, CoreExpr)] -> FullArgCount
    forall (t :: * -> *) a. Foldable t => t a -> FullArgCount
    length [(Var, CoreExpr)]
    binds1) RnEnv2
    env [(Var, CoreExpr)]
    binds1
     where go :: FullArgCount
    -> RnEnv2
    -> [(Var, CoreExpr)]
    -> [(Var, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go FullArgCount
    _    RnEnv2
    env []     []
              = ([], RnEnv2
    env)
           go FullArgCount
    fuel RnEnv2
    env [(Var, CoreExpr)]
    binds1 [(Var, CoreExpr)]
    binds2
              -- No binds left to compare? Bail out early.
              | [(Var, CoreExpr)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Var, CoreExpr)]
    binds1 Bool -> Bool -> Bool
    || [(Var, CoreExpr)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Var, CoreExpr)]
    binds2
              = (RnEnv2 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)] -> [SDoc]
    warn RnEnv2
    env [(Var, CoreExpr)]
    binds1 [(Var, CoreExpr)]
    binds2, RnEnv2
    env)
              -- Iterated over all binds without finding a match? Then
              -- try speculatively matching binders by order.
              | FullArgCount
    fuel FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == FullArgCount
    0
              = if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ RnEnv2
    env RnEnv2 -> Var -> Bool
    `inRnEnvL` (Var, CoreExpr) -> Var
    forall a b. (a, b) -> a
    fst ([(Var, CoreExpr)] -> (Var, CoreExpr)
    forall a. [a] -> a
    head [(Var, CoreExpr)]
    binds1)
                then let env' :: RnEnv2
    env' = ([Var] -> [Var] -> RnEnv2) -> ([Var], [Var]) -> RnEnv2
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (RnEnv2 -> [Var] -> [Var] -> RnEnv2
    rnBndrs2 RnEnv2
    env) (([Var], [Var]) -> RnEnv2) -> ([Var], [Var]) -> RnEnv2
    forall a b. (a -> b) -> a -> b
    $ [(Var, Var)] -> ([Var], [Var])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Var, Var)] -> ([Var], [Var])) -> [(Var, Var)] -> ([Var], [Var])
    forall a b. (a -> b) -> a -> b
    $
                                [Var] -> [Var] -> [(Var, Var)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([Var] -> [Var]
    forall a. Ord a => [a] -> [a]
    sort ([Var] -> [Var]) -> [Var] -> [Var]
    forall a b. (a -> b) -> a -> b
    $ ((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
    forall a b. (a -> b) -> [a] -> [b]
    map (Var, CoreExpr) -> Var
    forall a b. (a, b) -> a
    fst [(Var, CoreExpr)]
    binds1) ([Var] -> [Var]
    forall a. Ord a => [a] -> [a]
    sort ([Var] -> [Var]) -> [Var] -> [Var]
    forall a b. (a -> b) -> a -> b
    $ ((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
    forall a b. (a -> b) -> [a] -> [b]
    map (Var, CoreExpr) -> Var
    forall a b. (a, b) -> a
    fst [(Var, CoreExpr)]
    binds2)
                     in FullArgCount
    -> RnEnv2
    -> [(Var, CoreExpr)]
    -> [(Var, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go ([(Var, CoreExpr)] -> FullArgCount
    forall (t :: * -> *) a. Foldable t => t a -> FullArgCount
    length [(Var, CoreExpr)]
    binds1) RnEnv2
    env' [(Var, CoreExpr)]
    binds1 [(Var, CoreExpr)]
    binds2
                -- If we have already tried that, give up
                else (RnEnv2 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)] -> [SDoc]
    warn RnEnv2
    env [(Var, CoreExpr)]
    binds1 [(Var, CoreExpr)]
    binds2, RnEnv2
    env)
           go FullArgCount
    fuel RnEnv2
    env ((Var
    bndr1,CoreExpr
    expr1):[(Var, CoreExpr)]
    binds1) [(Var, CoreExpr)]
    binds2
              | let matchExpr :: (Var, CoreExpr) -> Bool
    matchExpr (Var
    bndr,CoreExpr
    expr) =
                      (Bool -> Bool
    not Bool
    top Bool -> Bool -> Bool
    || [SDoc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (RnEnv2 -> Var -> Var -> [SDoc]
    diffIdInfo RnEnv2
    env Var
    bndr Var
    bndr1)) Bool -> Bool -> Bool
    &&
                      [SDoc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top (RnEnv2 -> Var -> Var -> RnEnv2
    rnBndr2 RnEnv2
    env Var
    bndr1 Var
    bndr) CoreExpr
    expr1 CoreExpr
    expr)
              , ([(Var, CoreExpr)]
    binds2l, (Var
    bndr2,CoreExpr
    _):[(Var, CoreExpr)]
    binds2r) <- ((Var, CoreExpr) -> Bool)
    -> [(Var, CoreExpr)] -> ([(Var, CoreExpr)], [(Var, CoreExpr)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Var, CoreExpr) -> Bool
    matchExpr [(Var, CoreExpr)]
    binds2
              = FullArgCount
    -> RnEnv2
    -> [(Var, CoreExpr)]
    -> [(Var, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go ([(Var, CoreExpr)] -> FullArgCount
    forall (t :: * -> *) a. Foldable t => t a -> FullArgCount
    length [(Var, CoreExpr)]
    binds1) (RnEnv2 -> Var -> Var -> RnEnv2
    rnBndr2 RnEnv2
    env Var
    bndr1 Var
    bndr2)
                    [(Var, CoreExpr)]
    binds1 ([(Var, CoreExpr)]
    binds2l [(Var, CoreExpr)] -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
    forall a. [a] -> [a] -> [a]
    ++ [(Var, CoreExpr)]
    binds2r)
              | Bool
    otherwise -- No match, so push back (FIXME O(n^2))
              = FullArgCount
    -> RnEnv2
    -> [(Var, CoreExpr)]
    -> [(Var, CoreExpr)]
    -> ([SDoc], RnEnv2)
    go (FullArgCount
    fuelFullArgCount -> FullArgCount -> FullArgCount
    forall a. Num a => a -> a -> a
    -FullArgCount
    1) RnEnv2
    env ([(Var, CoreExpr)]
    binds1[(Var, CoreExpr)] -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
    forall a. [a] -> [a] -> [a]
    ++[(Var
    bndr1,CoreExpr
    expr1)]) [(Var, CoreExpr)]
    binds2
           go FullArgCount
    _ RnEnv2
    _ [(Var, CoreExpr)]
    _ [(Var, CoreExpr)]
    _ = String -> ([SDoc], RnEnv2)
    forall a. String -> a
    panic String
    "diffBinds: impossible" -- GHC isn't smart enough

           -- 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 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)] -> [SDoc]
    warn RnEnv2
    env [(Var, CoreExpr)]
    binds1 [(Var, CoreExpr)]
    binds2 =
             (((Var, CoreExpr), (Var, CoreExpr)) -> [SDoc])
    -> [((Var, CoreExpr), (Var, CoreExpr))] -> [SDoc]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (((Var, CoreExpr) -> (Var, CoreExpr) -> [SDoc])
    -> ((Var, CoreExpr), (Var, CoreExpr)) -> [SDoc]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (RnEnv2 -> (Var, CoreExpr) -> (Var, CoreExpr) -> [SDoc]
    diffBind RnEnv2
    env)) ([(Var, CoreExpr)]
    -> [(Var, CoreExpr)] -> [((Var, CoreExpr), (Var, CoreExpr))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Var, CoreExpr)]
    binds1' [(Var, CoreExpr)]
    binds2') [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++
             String -> [(Var, CoreExpr)] -> [SDoc]
    forall {b}. OutputableBndr b => String -> [(b, Expr b)] -> [SDoc]
    unmatched String
    "unmatched left-hand:" (FullArgCount -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
    forall a. FullArgCount -> [a] -> [a]
    drop FullArgCount
    l [(Var, CoreExpr)]
    binds1') [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++
             String -> [(Var, CoreExpr)] -> [SDoc]
    forall {b}. OutputableBndr b => String -> [(b, Expr b)] -> [SDoc]
    unmatched String
    "unmatched right-hand:" (FullArgCount -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
    forall a. FullArgCount -> [a] -> [a]
    drop FullArgCount
    l [(Var, CoreExpr)]
    binds2')
            where binds1' :: [(Var, CoreExpr)]
    binds1' = ((Var, CoreExpr) -> (Var, CoreExpr) -> Ordering)
    -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((Var, CoreExpr) -> Var)
    -> (Var, CoreExpr) -> (Var, CoreExpr) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Var, CoreExpr) -> Var
    forall a b. (a, b) -> a
    fst) [(Var, CoreExpr)]
    binds1
                  binds2' :: [(Var, CoreExpr)]
    binds2' = ((Var, CoreExpr) -> (Var, CoreExpr) -> Ordering)
    -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((Var, CoreExpr) -> Var)
    -> (Var, CoreExpr) -> (Var, CoreExpr) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Var, CoreExpr) -> Var
    forall a b. (a, b) -> a
    fst) [(Var, CoreExpr)]
    binds2
                  l :: FullArgCount
    l = FullArgCount -> FullArgCount -> FullArgCount
    forall a. Ord a => a -> a -> a
    min ([(Var, CoreExpr)] -> FullArgCount
    forall (t :: * -> *) a. Foldable t => t a -> FullArgCount
    length [(Var, CoreExpr)]
    binds1') ([(Var, CoreExpr)] -> FullArgCount
    forall (t :: * -> *) a. Foldable t => t a -> FullArgCount
    length [(Var, CoreExpr)]
    binds2')
           unmatched :: String -> [(b, Expr b)] -> [SDoc]
    unmatched String
    _   [] = []
           unmatched String
    txt [(b, Expr b)]
    bs = [String -> SDoc
    text String
    txt SDoc -> SDoc -> SDoc
    $$ 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 -> (Var, CoreExpr) -> (Var, CoreExpr) -> [SDoc]
    diffBind RnEnv2
    env (Var
    bndr1,CoreExpr
    expr1) (Var
    bndr2,CoreExpr
    expr2)
             | ds :: [SDoc]
    ds@(SDoc
    _:[SDoc]
    _) <- Bool -> RnEnv2 -> CoreExpr -> CoreExpr -> [SDoc]
    diffExpr Bool
    top RnEnv2
    env CoreExpr
    expr1 CoreExpr
    expr2
             = String -> Var -> Var -> [SDoc] -> [SDoc]
    locBind String
    "in binding" Var
    bndr1 Var
    bndr2 [SDoc]
    ds
             | Bool
    otherwise
             = RnEnv2 -> Var -> Var -> [SDoc]
    diffIdInfo RnEnv2
    env Var
    bndr1 Var
    bndr2

    -- | Find differences in @IdInfo@. We will especially check whether
    -- the unfoldings match, if present (see @diffUnfold@).
    diffIdInfo :: RnEnv2 -> Var -> Var -> [SDoc]
    diffIdInfo :: RnEnv2 -> Var -> Var -> [SDoc]
    diffIdInfo RnEnv2
    env Var
    bndr1 Var
    bndr2
      | IdInfo -> FullArgCount
    arityInfo IdInfo
    info1 FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> FullArgCount
    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 -> FullArgCount
    callArityInfo IdInfo
    info1 FullArgCount -> FullArgCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> FullArgCount
    callArityInfo IdInfo
    info2
        Bool -> Bool -> Bool
    && IdInfo -> LevityInfo
    levityInfo IdInfo
    info1 LevityInfo -> LevityInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == IdInfo -> LevityInfo
    levityInfo IdInfo
    info2
      = String -> Var -> Var -> [SDoc] -> [SDoc]
    locBind String
    "in unfolding of" Var
    bndr1 Var
    bndr2 ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $
        RnEnv2 -> Unfolding -> Unfolding -> [SDoc]
    diffUnfold RnEnv2
    env (IdInfo -> Unfolding
    unfoldingInfo IdInfo
    info1) (IdInfo -> Unfolding
    unfoldingInfo IdInfo
    info2)
      | Bool
    otherwise
      = String -> Var -> Var -> [SDoc] -> [SDoc]
    locBind String
    "in Id info of" Var
    bndr1 Var
    bndr2
        [[SDoc] -> SDoc
    fsep [BindingSite -> Var -> SDoc
    forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LetBind Var
    bndr1, String -> SDoc
    text String
    "/=", BindingSite -> Var -> SDoc
    forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LetBind Var
    bndr2]]
      where info1 :: IdInfo
    info1 = HasDebugCallStack => Var -> IdInfo
    Var -> IdInfo
    idInfo Var
    bndr1; info2 :: IdInfo
    info2 = HasDebugCallStack => Var -> IdInfo
    Var -> IdInfo
    idInfo Var
    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 [Var]
    bs1 DataCon
    c1 [CoreExpr]
    a1)
                   (DFunUnfolding [Var]
    bs2 DataCon
    c2 [CoreExpr]
    a2)
      | DataCon
    c1 DataCon -> DataCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon
    c2 Bool -> Bool -> Bool
    && [Var] -> [Var] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [Var]
    bs1 [Var]
    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 -> [Var] -> [Var] -> RnEnv2
    rnBndrs2 RnEnv2
    env [Var]
    bs1 [Var]
    bs2
    diffUnfold RnEnv2
    env (CoreUnfolding CoreExpr
    t1 UnfoldingSource
    _ Bool
    _ Bool
    v1 Bool
    cl1 Bool
    wf1 Bool
    x1 UnfoldingGuidance
    g1)
                   (CoreUnfolding CoreExpr
    t2 UnfoldingSource
    _ Bool
    _ Bool
    v2 Bool
    cl2 Bool
    wf2 Bool
    x2 UnfoldingGuidance
    g2)
      | Bool
    v1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    v2 Bool -> Bool -> Bool
    && Bool
    cl1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    cl2
        Bool -> Bool -> Bool
    && Bool
    wf1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    wf2 Bool -> Bool -> Bool
    && Bool
    x1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    x2 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
    fsep [Unfolding -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unfolding
    uf1, String -> SDoc
    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 -> Var -> Var -> [SDoc] -> [SDoc]
    locBind String
    loc Var
    b1 Var
    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
    $$ FullArgCount -> SDoc -> SDoc
    nest FullArgCount
    2 (SDoc -> SDoc
    parens (String -> SDoc
    text String
    loc SDoc -> SDoc -> SDoc
    <+> SDoc
    bindLoc))
            bindLoc :: SDoc
    bindLoc | Var
    b1 Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    b2  = Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Var
    b1
                    | Bool
    otherwise = Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Var
    b1 SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '/' SDoc -> SDoc -> SDoc
    <> Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Var
    b2

    {-
    ************************************************************************
    *                                                                      *
                    Eta reduction
    *                                                                      *
    ************************************************************************

    Note [Eta reduction conditions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We try for eta reduction here, but *only* if we get all the way to an
    trivial expression.  We don't want to remove extra lambdas unless we
    are going to avoid allocating this thing altogether.

    There are some particularly delicate points here:

    * We want to eta-reduce if doing so leaves a trivial expression,
      *including* a cast.  For example
           \x. f |> co  -->  f |> co
      (provided co doesn't mention x)

    * Eta reduction is not valid in general:
            \x. bot  /=  bot
      This matters, partly for old-fashioned correctness reasons but,
      worse, getting it wrong can yield a seg fault. Consider
            f = \x.f x
            h y = case (case y of { True -> f `seq` True; False -> False }) of
                    True -> ...; False -> ...

      If we (unsoundly) eta-reduce f to get f=f, the strictness analyser
      says f=bottom, and replaces the (f `seq` True) with just
      (f `cast` unsafe-co).  BUT, as thing stand, 'f' got arity 1, and it
      *keeps* arity 1 (perhaps also wrongly).  So CorePrep eta-expands
      the definition again, so that it does not terminate after all.
      Result: seg-fault because the boolean case actually gets a function value.
      See #1947.

      So it's important to do the right thing.

    * With linear types, eta-reduction can break type-checking:
            f :: A ⊸ B
            g :: A -> B
            g = \x. f x

      The above is correct, but eta-reducing g would yield g=f, the linter will
      complain that g and f don't have the same type.

    * Note [Arity care]: we need to be careful if we just look at f's
      arity. Currently (Dec07), f's arity is visible in its own RHS (see
      Note [Arity robustness] in GHC.Core.Opt.Simplify.Env) so we must *not* trust the
      arity when checking that 'f' is a value.  Otherwise we will
      eta-reduce
          f = \x. f x
      to
          f = f
      Which might change a terminating program (think (f `seq` e)) to a
      non-terminating one.  So we check for being a loop breaker first.

      However for GlobalIds we can look at the arity; and for primops we
      must, since they have no unfolding.

    * Regardless of whether 'f' is a value, we always want to
      reduce (/\a -> f a) to f
      This came up in a RULE: foldr (build (/\a -> g a))
      did not match           foldr (build (/\b -> ...something complex...))
      The type checker can insert these eta-expanded versions,
      with both type and dictionary lambdas; hence the slightly
      ad-hoc isDictId

    * Never *reduce* arity. For example
          f = \xy. g x y
      Then if h has arity 1 we don't want to eta-reduce because then
      f's arity would decrease, and that is bad

    These delicacies are why we don't use exprIsTrivial and exprIsHNF here.
    Alas.

    Note [Eta reduction with casted arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
        (\(x:t3). f (x |> g)) :: t3 -> t2
      where
        f :: t1 -> t2
        g :: t3 ~ t1
    This should be eta-reduced to

        f |> (sym g -> t2)

    So we need to accumulate a coercion, pushing it inward (past
    variable arguments only) thus:
       f (x |> co_arg) |> co  -->  (f |> (sym co_arg -> co)) x
       f (x:t)         |> co  -->  (f |> (t -> co)) x
       f @ a           |> co  -->  (f |> (forall a.co)) @ a
       f @ (g:t1~t2)   |> co  -->  (f |> (t1~t2 => co)) @ (g:t1~t2)
    These are the equations for ok_arg.

    It's true that we could also hope to eta reduce these:
        (\xy. (f x |> g) y)
        (\xy. (f x y) |> g)
    But the simplifier pushes those casts outwards, so we don't
    need to address that here.
    -}

    -- When updating this function, make sure to update
    -- CorePrep.tryEtaReducePrep as well!
    tryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr
    tryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr
    tryEtaReduce [Var]
    bndrs CoreExpr
    body
      = [Var] -> CoreExpr -> CoercionR -> Maybe CoreExpr
    go ([Var] -> [Var]
    forall a. [a] -> [a]
    reverse [Var]
    bndrs) CoreExpr
    body (Type -> CoercionR
    mkRepReflCo (CoreExpr -> Type
    exprType CoreExpr
    body))
      where
        incoming_arity :: FullArgCount
    incoming_arity = (Var -> Bool) -> [Var] -> FullArgCount
    forall a. (a -> Bool) -> [a] -> FullArgCount
    count Var -> Bool
    isId [Var]
    bndrs

        go :: [Var]            -- Binders, innermost first, types [a3,a2,a1]
           -> CoreExpr         -- Of type tr
           -> Coercion         -- Of type tr ~ ts
           -> Maybe CoreExpr   -- Of type a1 -> a2 -> a3 -> ts
        -- See Note [Eta reduction with casted arguments]
        -- for why we have an accumulating coercion
        go :: [Var] -> CoreExpr -> CoercionR -> Maybe CoreExpr
    go [] CoreExpr
    fun CoercionR
    co
          | CoreExpr -> Bool
    ok_fun CoreExpr
    fun
          , let used_vars :: VarSet
    used_vars = CoreExpr -> VarSet
    exprFreeVars CoreExpr
    fun VarSet -> VarSet -> VarSet
    `unionVarSet` CoercionR -> VarSet
    tyCoVarsOfCo CoercionR
    co
          , Bool -> Bool
    not ((Var -> Bool) -> [Var] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Var -> VarSet -> Bool
    `elemVarSet` VarSet
    used_vars) [Var]
    bndrs)
          = CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (CoreExpr -> CoercionR -> CoreExpr
    mkCast CoreExpr
    fun CoercionR
    co)   -- Check for any of the binders free in the result
                                   -- including the accumulated coercion

        go [Var]
    bs (Tick CoreTickish
    t CoreExpr
    e) CoercionR
    co
          | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreTickish
    t
          = (CoreExpr -> CoreExpr) -> Maybe CoreExpr -> Maybe CoreExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    t) (Maybe CoreExpr -> Maybe CoreExpr)
    -> Maybe CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [Var] -> CoreExpr -> CoercionR -> Maybe CoreExpr
    go [Var]
    bs CoreExpr
    e CoercionR
    co
          -- Float app ticks: \x -> Tick t (e x) ==> Tick t e

        go (Var
    b : [Var]
    bs) (App CoreExpr
    fun CoreExpr
    arg) CoercionR
    co
          | Just (CoercionR
    co', [CoreTickish]
    ticks) <- Var
    -> CoreExpr
    -> CoercionR
    -> Type
    -> Maybe (CoercionR, [CoreTickish])
    ok_arg Var
    b CoreExpr
    arg CoercionR
    co (CoreExpr -> Type
    exprType CoreExpr
    fun)
          = (CoreExpr -> CoreExpr) -> Maybe CoreExpr -> Maybe CoreExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((CoreExpr -> [CoreTickish] -> CoreExpr)
    -> [CoreTickish] -> CoreExpr -> CoreExpr
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((CoreTickish -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [CoreTickish] -> CoreExpr
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CoreTickish -> CoreExpr -> CoreExpr
    mkTick) [CoreTickish]
    ticks) (Maybe CoreExpr -> Maybe CoreExpr)
    -> Maybe CoreExpr -> Maybe CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [Var] -> CoreExpr -> CoercionR -> Maybe CoreExpr
    go [Var]
    bs CoreExpr
    fun CoercionR
    co'
                -- Float arg ticks: \x -> e (Tick t x) ==> Tick t e

        go [Var]
    _ CoreExpr
    _ CoercionR
    _  = Maybe CoreExpr
    forall a. Maybe a
    Nothing         -- Failure!

        ---------------
        -- Note [Eta reduction conditions]
        ok_fun :: CoreExpr -> Bool
    ok_fun (App CoreExpr
    fun (Type {})) = CoreExpr -> Bool
    ok_fun CoreExpr
    fun
        ok_fun (Cast CoreExpr
    fun CoercionR
    _)        = CoreExpr -> Bool
    ok_fun CoreExpr
    fun
        ok_fun (Tick CoreTickish
    _ CoreExpr
    expr)       = CoreExpr -> Bool
    ok_fun CoreExpr
    expr
        ok_fun (Var Var
    fun_id)        = Var -> Bool
    ok_fun_id Var
    fun_id Bool -> Bool -> Bool
    || (Var -> Bool) -> [Var] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Var -> Bool
    ok_lam [Var]
    bndrs
        ok_fun CoreExpr
    _fun                = Bool
    False

        ---------------
        ok_fun_id :: Var -> Bool
    ok_fun_id Var
    fun = Var -> FullArgCount
    fun_arity Var
    fun FullArgCount -> FullArgCount -> Bool
    forall a. Ord a => a -> a -> Bool
    >= FullArgCount
    incoming_arity

        ---------------
        fun_arity :: Var -> FullArgCount
    fun_arity Var
    fun             -- See Note [Arity care]
           | Var -> Bool
    isLocalId Var
    fun
           , OccInfo -> Bool
    isStrongLoopBreaker (Var -> OccInfo
    idOccInfo Var
    fun) = FullArgCount
    0
           | FullArgCount
    arity FullArgCount -> FullArgCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > FullArgCount
    0                           = FullArgCount
    arity
           | Unfolding -> Bool
    isEvaldUnfolding (Var -> Unfolding
    idUnfolding Var
    fun)  = FullArgCount
    1
                -- See Note [Eta reduction of an eval'd function]
           | Bool
    otherwise                           = FullArgCount
    0
           where
             arity :: FullArgCount
    arity = Var -> FullArgCount
    idArity Var
    fun

        ---------------
        ok_lam :: Var -> Bool
    ok_lam Var
    v = Var -> Bool
    isTyVar Var
    v Bool -> Bool -> Bool
    || Var -> Bool
    isEvVar Var
    v

        ---------------
        ok_arg :: Var              -- Of type bndr_t
               -> CoreExpr         -- Of type arg_t
               -> Coercion         -- Of kind (t1~t2)
               -> Type             -- Type of the function to which the argument is applied
               -> Maybe (Coercion  -- Of type (arg_t -> t1 ~  bndr_t -> t2)
                                   --   (and similarly for tyvars, coercion args)
                        , [CoreTickish])
        -- See Note [Eta reduction with casted arguments]
        ok_arg :: Var
    -> CoreExpr
    -> CoercionR
    -> Type
    -> Maybe (CoercionR, [CoreTickish])
    ok_arg Var
    bndr (Type Type
    ty) CoercionR
    co Type
    _
           | Just Var
    tv <- Type -> Maybe Var
    getTyVar_maybe Type
    ty
           , Var
    bndr Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    tv  = (CoercionR, [CoreTickish]) -> Maybe (CoercionR, [CoreTickish])
    forall a. a -> Maybe a
    Just ([Var] -> CoercionR -> CoercionR
    mkHomoForAllCos [Var
    tv] CoercionR
    co, [])
        ok_arg Var
    bndr (Var Var
    v) CoercionR
    co Type
    fun_ty
           | Var
    bndr Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    v
           , let mult :: Type
    mult = Var -> Type
    idMult Var
    bndr
           , Just (Type
    fun_mult, Type
    _, Type
    _) <- Type -> Maybe (Type, Type, Type)
    splitFunTy_maybe Type
    fun_ty
           , Type
    mult Type -> Type -> Bool
    `eqType` Type
    fun_mult -- There is no change in multiplicity, otherwise we must abort
           = let reflCo :: CoercionR
    reflCo = Type -> CoercionR
    mkRepReflCo (Var -> Type
    idType Var
    bndr)
             in (CoercionR, [CoreTickish]) -> Maybe (CoercionR, [CoreTickish])
    forall a. a -> Maybe a
    Just (Role -> CoercionR -> CoercionR -> CoercionR -> CoercionR
    mkFunCo Role
    Representational (Type -> CoercionR
    multToCo Type
    mult) CoercionR
    reflCo CoercionR
    co, [])
        ok_arg Var
    bndr (Cast CoreExpr
    e CoercionR
    co_arg) CoercionR
    co Type
    fun_ty
           | ([CoreTickish]
    ticks, Var Var
    v) <- (CoreTickish -> Bool) -> CoreExpr -> ([CoreTickish], CoreExpr)
    forall b.
    (CoreTickish -> Bool) -> Expr b -> ([CoreTickish], Expr b)
    stripTicksTop CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreExpr
    e
           , Just (Type
    fun_mult, Type
    _, Type
    _) <- Type -> Maybe (Type, Type, Type)
    splitFunTy_maybe Type
    fun_ty
           , Var
    bndr Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    v
           , Type
    fun_mult Type -> Type -> Bool
    `eqType` Var -> Type
    idMult Var
    bndr
           = (CoercionR, [CoreTickish]) -> Maybe (CoercionR, [CoreTickish])
    forall a. a -> Maybe a
    Just (Role -> CoercionR -> CoercionR -> CoercionR -> CoercionR
    mkFunCo Role
    Representational (Type -> CoercionR
    multToCo Type
    fun_mult) (CoercionR -> CoercionR
    mkSymCo CoercionR
    co_arg) CoercionR
    co, [CoreTickish]
    ticks)
           -- The simplifier combines multiple casts into one,
           -- so we can have a simple-minded pattern match here
        ok_arg Var
    bndr (Tick CoreTickish
    t CoreExpr
    arg) CoercionR
    co Type
    fun_ty
           | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreTickish
    t, Just (CoercionR
    co', [CoreTickish]
    ticks) <- Var
    -> CoreExpr
    -> CoercionR
    -> Type
    -> Maybe (CoercionR, [CoreTickish])
    ok_arg Var
    bndr CoreExpr
    arg CoercionR
    co Type
    fun_ty
           = (CoercionR, [CoreTickish]) -> Maybe (CoercionR, [CoreTickish])
    forall a. a -> Maybe a
    Just (CoercionR
    co', CoreTickish
    tCoreTickish -> [CoreTickish] -> [CoreTickish]
    forall a. a -> [a] -> [a]
    :[CoreTickish]
    ticks)

        ok_arg Var
    _ CoreExpr
    _ CoercionR
    _ Type
    _ = Maybe (CoercionR, [CoreTickish])
    forall a. Maybe a
    Nothing

    {-
    Note [Eta reduction of an eval'd function]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In Haskell it is not true that    f = \x. f x
    because f might be bottom, and 'seq' can distinguish them.

    But it *is* true that   f = f `seq` \x. f x
    and we'd like to simplify the latter to the former.  This amounts
    to the rule that
      * when there is just *one* value argument,
      * f is not bottom
    we can eta-reduce    \x. f x  ===>  f

    This turned up in #7542.
    -}

    {- *********************************************************************
    *                                                                      *
                      Zapping lambda binders
    *                                                                      *
    ********************************************************************* -}

    zapLamBndrs :: FullArgCount -> [Var] -> [Var]
    -- If (\xyz. t) appears under-applied to only two arguments,
    -- we must zap the occ-info on x,y, because they appear under the \x
    -- See Note [Occurrence analysis for lambda binders] in GHc.Core.Opt.OccurAnal
    --
    -- NB: both `arg_count` and `bndrs` include both type and value args/bndrs
    zapLamBndrs :: FullArgCount -> [Var] -> [Var]
    zapLamBndrs FullArgCount
    arg_count [Var]
    bndrs
      | Bool
    no_need_to_zap = [Var]
    bndrs
      | Bool
    otherwise      = FullArgCount -> [Var] -> [Var]
    zap_em FullArgCount
    arg_count [Var]
    bndrs
      where
        no_need_to_zap :: Bool
    no_need_to_zap = (Var -> Bool) -> [Var] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Var -> Bool
    isOneShotBndr (FullArgCount -> [Var] -> [Var]
    forall a. FullArgCount -> [a] -> [a]
    drop FullArgCount
    arg_count [Var]
    bndrs)

        zap_em :: FullArgCount -> [Var] -> [Var]
        zap_em :: FullArgCount -> [Var] -> [Var]
    zap_em FullArgCount
    0 [Var]
    bs = [Var]
    bs
        zap_em FullArgCount
    _ [] = []
        zap_em FullArgCount
    n (Var
    b:[Var]
    bs) | Var -> Bool
    isTyVar Var
    b = Var
    b              Var -> [Var] -> [Var]
    forall a. a -> [a] -> [a]
    : FullArgCount -> [Var] -> [Var]
    zap_em (FullArgCount
    nFullArgCount -> FullArgCount -> FullArgCount
    forall a. Num a => a -> a -> a
    -FullArgCount
    1) [Var]
    bs
                        | Bool
    otherwise = Var -> Var
    zapLamIdInfo Var
    b Var -> [Var] -> [Var]
    forall a. a -> [a] -> [a]
    : FullArgCount -> [Var] -> [Var]
    zap_em (FullArgCount
    nFullArgCount -> FullArgCount -> FullArgCount
    forall a. Num a => a -> a -> a
    -FullArgCount
    1) [Var]
    bs

    {- *********************************************************************
    *                                                                      *
    \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

    {-
    *****************************************************
    *
    * 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 Var
    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
        , Var -> Name
    idName Var
    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 Var -> Bool
    isJoinBind (NonRec Var
    b CoreExpr
    _)       = Var -> Bool
    isJoinId Var
    b
    isJoinBind (Rec ((Var
    b, CoreExpr
    _) : [(Var, CoreExpr)]
    _)) = Var -> Bool
    isJoinId Var
    b
    isJoinBind Bind Var
    _                  = Bool
    False

    dumpIdInfoOfProgram :: (IdInfo -> SDoc) -> CoreProgram -> SDoc
    dumpIdInfoOfProgram :: (IdInfo -> SDoc) -> [Bind Var] -> SDoc
    dumpIdInfoOfProgram IdInfo -> SDoc
    ppr_id_info [Bind Var]
    binds = [SDoc] -> SDoc
    vcat ((Var -> SDoc) -> [Var] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Var -> SDoc
    printId [Var]
    ids)
      where
      ids :: [Var]
    ids = (Var -> Var -> Ordering) -> [Var] -> [Var]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Name -> Name -> Ordering
    stableNameCmp (Name -> Name -> Ordering)
    -> (Var -> Name) -> Var -> Var -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Var -> Name
    forall a. NamedThing a => a -> Name
    getName) ((Bind Var -> [Var]) -> [Bind Var] -> [Var]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Bind Var -> [Var]
    forall {a}. Bind a -> [a]
    getIds [Bind Var]
    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
      printId :: Var -> SDoc
    printId Var
    id | Var -> Bool
    isExportedId Var
    id = Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Var
    id SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    <+> (IdInfo -> SDoc
    ppr_id_info (HasDebugCallStack => Var -> IdInfo
    Var -> IdInfo
    idInfo Var
    id))
                 | Bool
    otherwise       = SDoc
    empty

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

    isUnsafeEqualityProof :: CoreExpr -> Bool
    -- See (U3) and (U4) in
    -- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce
    isUnsafeEqualityProof :: CoreExpr -> Bool
    isUnsafeEqualityProof CoreExpr
    e
      | Var Var
    v `App` Type Type
    _ `App` Type Type
    _ `App` Type Type
    _ <- CoreExpr
    e
      = Var -> Name
    idName Var
    v Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    unsafeEqualityProofName
      | Bool
    otherwise
      = Bool
    False