    {-# LANGUAGE CPP #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    -- | Handy functions for creating much Core syntax
    module GHC.Core.Make (
            -- * Constructing normal syntax
            mkCoreLet, mkCoreLets,
            mkCoreApp, mkCoreApps, mkCoreConApps,
            mkCoreLams, mkWildCase, mkIfThenElse,
            mkWildValBinder, mkWildEvBinder,
            mkSingleAltCase,
            sortQuantVars, castBottomExpr,

            -- * Constructing boxed literals
            mkWordExpr,
            mkIntExpr, mkIntExprInt, mkUncheckedIntExpr,
            mkIntegerExpr, mkNaturalExpr,
            mkFloatExpr, mkDoubleExpr,
            mkCharExpr, mkStringExpr, mkStringExprFS, mkStringExprFSWith,

            -- * Floats
            FloatBind(..), wrapFloat, wrapFloats, floatBindings,

            -- * Constructing small tuples
            mkCoreVarTupTy, mkCoreTup, mkCoreUbxTup, mkCoreUbxSum,
            mkCoreTupBoxity, unitExpr,

            -- * Constructing big tuples
            mkBigCoreVarTup, mkBigCoreVarTup1,
            mkBigCoreVarTupTy, mkBigCoreTupTy,
            mkBigCoreTup,

            -- * Deconstructing small tuples
            mkSmallTupleSelector, mkSmallTupleCase,

            -- * Deconstructing big tuples
            mkTupleSelector, mkTupleSelector1, mkTupleCase,

            -- * Constructing list expressions
            mkNilExpr, mkConsExpr, mkListExpr,
            mkFoldrExpr, mkBuildExpr,

            -- * Constructing non empty lists
            mkNonEmptyListExpr,

            -- * Constructing Maybe expressions
            mkNothingExpr, mkJustExpr,

            -- * Error Ids
            mkRuntimeErrorApp, mkImpossibleExpr, mkAbsentErrorApp, errorIds,
            rEC_CON_ERROR_ID, rUNTIME_ERROR_ID,
            nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
            pAT_ERROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID,
            tYPE_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID
        ) where

    #include "HsVersions.h"

    import GHC.Prelude
    import GHC.Platform

    import GHC.Types.Id
    import GHC.Types.Var  ( EvVar, setTyVarUnique )
    import GHC.Types.TyThing
    import GHC.Types.Id.Info
    import GHC.Types.Demand
    import GHC.Types.Cpr
    import GHC.Types.Name      hiding ( varName )
    import GHC.Types.Literal
    import GHC.Types.Unique.Supply
    import GHC.Types.Basic

    import GHC.Core
    import GHC.Core.Utils ( exprType, needsCaseBinding, mkSingleAltCase, bindNonRec )
    import GHC.Core.Type
    import GHC.Core.Coercion ( isCoVar )
    import GHC.Core.DataCon  ( DataCon, dataConWorkId )
    import GHC.Core.Multiplicity

    import GHC.Hs.Utils      ( mkChunkified, chunkify )

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

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

    import GHC.Data.FastString

    import Data.List        ( partition )
    import Data.Char        ( ord )

    infixl 4 `mkCoreApp`, `mkCoreApps`

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Basic GHC.Core construction}
    *                                                                      *
    ************************************************************************
    -}
    sortQuantVars :: [Var] -> [Var]
    -- Sort the variables, putting type and covars first, in scoped order,
    -- and then other Ids
    -- It is a deterministic sort, meaining it doesn't look at the values of
    -- Uniques. For explanation why it's important See Note [Unique Determinism]
    -- in GHC.Types.Unique.
    sortQuantVars :: [Id] -> [Id]
    sortQuantVars [Id]
    vs = [Id]
    sorted_tcvs forall a. [a] -> [a] -> [a]
    ++ [Id]
    ids
      where
        ([Id]
    tcvs, [Id]
    ids) = forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Id -> Bool
    isTyVar forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
    <||> Id -> Bool
    isCoVar) [Id]
    vs
        sorted_tcvs :: [Id]
    sorted_tcvs = [Id] -> [Id]
    scopedSort [Id]
    tcvs

    -- | Bind a binding group over an expression, using a @let@ or @case@ as
    -- appropriate (see "GHC.Core#let_app_invariant")
    mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr
    mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr
    mkCoreLet (NonRec Id
    bndr CoreExpr
    rhs) CoreExpr
    body        -- See Note [Core let/app invariant]
      = Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    bndr CoreExpr
    rhs CoreExpr
    body
    mkCoreLet CoreBind
    bind CoreExpr
    body
      = forall b. Bind b -> Expr b -> Expr b
    Let CoreBind
    bind CoreExpr
    body

    -- | Create a lambda where the given expression has a number of variables
    -- bound over it. The leftmost binder is that bound by the outermost
    -- lambda in the result
    mkCoreLams :: [CoreBndr] -> CoreExpr -> CoreExpr
    mkCoreLams :: [Id] -> CoreExpr -> CoreExpr
    mkCoreLams = forall b. [b] -> Expr b -> Expr b
    mkLams

    -- | Bind a list of binding groups over an expression. The leftmost binding
    -- group becomes the outermost group in the resulting expression
    mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr
    mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr
    mkCoreLets [CoreBind]
    binds CoreExpr
    body = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CoreBind -> CoreExpr -> CoreExpr
    mkCoreLet CoreExpr
    body [CoreBind]
    binds

    -- | Construct an expression which represents the application of a number of
    -- expressions to that of a data constructor expression. The leftmost expression
    -- in the list is applied first
    mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    con [CoreExpr]
    args = CoreExpr -> [CoreExpr] -> CoreExpr
    mkCoreApps (forall b. Id -> Expr b
    Var (DataCon -> Id
    dataConWorkId DataCon
    con)) [CoreExpr]
    args

    -- | Construct an expression which represents the application of a number of
    -- expressions to another. The leftmost expression in the list is applied first
    -- Respects the let/app invariant by building a case expression where necessary
    --   See Note [Core let/app invariant] in "GHC.Core"
    mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr
    mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr
    mkCoreApps CoreExpr
    fun [CoreExpr]
    args
      = forall a b. (a, b) -> a
    fst forall a b. (a -> b) -> a -> b
    $
        forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)
    mkCoreAppTyped SDoc
    doc_string) (CoreExpr
    fun, Type
    fun_ty) [CoreExpr]
    args
      where
        doc_string :: SDoc
    doc_string = forall a. Outputable a => a -> SDoc
    ppr Type
    fun_ty SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    fun SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    args
        fun_ty :: Type
    fun_ty = CoreExpr -> Type
    exprType CoreExpr
    fun

    -- | Construct an expression which represents the application of one expression
    -- to the other
    -- Respects the let/app invariant by building a case expression where necessary
    --   See Note [Core let/app invariant] in "GHC.Core"
    mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
    mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
    mkCoreApp SDoc
    s CoreExpr
    fun CoreExpr
    arg
      = forall a b. (a, b) -> a
    fst forall a b. (a -> b) -> a -> b
    $ SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)
    mkCoreAppTyped SDoc
    s (CoreExpr
    fun, CoreExpr -> Type
    exprType CoreExpr
    fun) CoreExpr
    arg

    -- | Construct an expression which represents the application of one expression
    -- paired with its type to an argument. The result is paired with its type. This
    -- function is not exported and used in the definition of 'mkCoreApp' and
    -- 'mkCoreApps'.
    -- Respects the let/app invariant by building a case expression where necessary
    --   See Note [Core let/app invariant] in "GHC.Core"
    mkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)
    mkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)
    mkCoreAppTyped SDoc
    _ (CoreExpr
    fun, Type
    fun_ty) (Type Type
    ty)
      = (forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun (forall b. Type -> Expr b
    Type Type
    ty), HasDebugCallStack => Type -> Type -> Type
    piResultTy Type
    fun_ty Type
    ty)
    mkCoreAppTyped SDoc
    _ (CoreExpr
    fun, Type
    fun_ty) (Coercion Coercion
    co)
      = (forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun (forall b. Coercion -> Expr b
    Coercion Coercion
    co), Type -> Type
    funResultTy Type
    fun_ty)
    mkCoreAppTyped SDoc
    d (CoreExpr
    fun, Type
    fun_ty) CoreExpr
    arg
      = ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg $$ d )
        (CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
    mkValApp CoreExpr
    fun CoreExpr
    arg (forall a. Type -> a -> Scaled a
    Scaled Type
    mult Type
    arg_ty) Type
    res_ty, Type
    res_ty)
      where
        (Type
    mult, Type
    arg_ty, Type
    res_ty) = Type -> (Type, Type, Type)
    splitFunTy Type
    fun_ty

    mkValApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
    -- Build an application (e1 e2),
    -- or a strict binding  (case e2 of x -> e1 x)
    -- using the latter when necessary to respect the let/app invariant
    --   See Note [Core let/app invariant] in GHC.Core
    mkValApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
    mkValApp CoreExpr
    fun CoreExpr
    arg (Scaled Type
    w Type
    arg_ty) Type
    res_ty
      | Bool -> Bool
    not (Type -> CoreExpr -> Bool
    needsCaseBinding Type
    arg_ty CoreExpr
    arg)
      = forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun CoreExpr
    arg                -- The vastly common case
      | Bool
    otherwise
      = CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
    mkStrictApp CoreExpr
    fun CoreExpr
    arg (forall a. Type -> a -> Scaled a
    Scaled Type
    w Type
    arg_ty) Type
    res_ty

    {- *********************************************************************
    *                                                                      *
                  Building case expressions
    *                                                                      *
    ********************************************************************* -}

    mkWildEvBinder :: PredType -> EvVar
    mkWildEvBinder :: Type -> Id
    mkWildEvBinder Type
    pred = Type -> Type -> Id
    mkWildValBinder Type
    Many Type
    pred

    -- | Make a /wildcard binder/. This is typically used when you need a binder
    -- that you expect to use only at a *binding* site.  Do not use it at
    -- occurrence sites because it has a single, fixed unique, and it's very
    -- easy to get into difficulties with shadowing.  That's why it is used so little.
    -- See Note [WildCard binders] in "GHC.Core.Opt.Simplify.Env"
    mkWildValBinder :: Mult -> Type -> Id
    mkWildValBinder :: Type -> Type -> Id
    mkWildValBinder Type
    w Type
    ty = Name -> Type -> Type -> Id
    mkLocalIdOrCoVar Name
    wildCardName Type
    w Type
    ty
      -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors
      -- (e.g. see test T15695). Ticket #17291 covers fixing this problem.

    mkWildCase :: CoreExpr -> Scaled Type -> Type -> [CoreAlt] -> CoreExpr
    -- Make a case expression whose case binder is unused
    -- The alts and res_ty should not have any occurrences of WildId
    mkWildCase :: CoreExpr -> Scaled Type -> Type -> [CoreAlt] -> CoreExpr
    mkWildCase CoreExpr
    scrut (Scaled Type
    w Type
    scrut_ty) Type
    res_ty [CoreAlt]
    alts
      = forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    scrut (Type -> Type -> Id
    mkWildValBinder Type
    w Type
    scrut_ty) Type
    res_ty [CoreAlt]
    alts

    mkStrictApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
    -- Build a strict application (case e2 of x -> e1 x)
    mkStrictApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
    mkStrictApp CoreExpr
    fun CoreExpr
    arg (Scaled Type
    w Type
    arg_ty) Type
    res_ty
      = forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    arg Id
    arg_id Type
    res_ty [forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt AltCon
    DEFAULT [] (forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun (forall b. Id -> Expr b
    Var Id
    arg_id))]
           -- mkDefaultCase looks attractive here, and would be sound.
           -- But it uses (exprType alt_rhs) to compute the result type,
           -- whereas here we already know that the result type is res_ty
      where
        arg_id :: Id
    arg_id = Type -> Type -> Id
    mkWildValBinder Type
    w Type
    arg_ty
            -- Lots of shadowing, but it doesn't matter,
            -- because 'fun' and 'res_ty' should not have a free wild-id
            --
            -- This is Dangerous.  But this is the only place we play this
            -- game, mkStrictApp returns an expression that does not have
            -- a free wild-id.  So the only way 'fun' could get a free wild-id
            -- would be if you take apart this case expression (or some other
            -- expression that uses mkWildValBinder, of which there are not
            -- many), and pass a fragment of it as the fun part of a 'mkStrictApp'.

    mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
    mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
    mkIfThenElse CoreExpr
    guard CoreExpr
    then_expr CoreExpr
    else_expr
    -- Not going to be refining, so okay to take the type of the "then" clause
      = CoreExpr -> Scaled Type -> Type -> [CoreAlt] -> CoreExpr
    mkWildCase CoreExpr
    guard (forall a. a -> Scaled a
    linear Type
    boolTy) (CoreExpr -> Type
    exprType CoreExpr
    then_expr)
             [ forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt DataCon
    falseDataCon) [] CoreExpr
    else_expr,       -- Increasing order of tag!
               forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt DataCon
    trueDataCon)  [] CoreExpr
    then_expr ]

    castBottomExpr :: CoreExpr -> Type -> CoreExpr
    -- (castBottomExpr e ty), assuming that 'e' diverges,
    -- return an expression of type 'ty'
    -- See Note [Empty case alternatives] in GHC.Core
    castBottomExpr :: CoreExpr -> Type -> CoreExpr
    castBottomExpr CoreExpr
    e Type
    res_ty
      | Type
    e_ty Type -> Type -> Bool
    `eqType` Type
    res_ty = CoreExpr
    e
      | Bool
    otherwise            = forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    e (Type -> Type -> Id
    mkWildValBinder Type
    One Type
    e_ty) Type
    res_ty []
      where
        e_ty :: Type
    e_ty = CoreExpr -> Type
    exprType CoreExpr
    e

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Making literals}
    *                                                                      *
    ************************************************************************
    -}

    -- | Create a 'CoreExpr' which will evaluate to the given @Int@
    mkIntExpr :: Platform -> Integer -> CoreExpr        -- Result = I# i :: Int
    mkIntExpr :: Platform -> Integer -> CoreExpr
    mkIntExpr Platform
    platform Integer
    i = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    intDataCon  [forall b. Platform -> Integer -> Expr b
    mkIntLit Platform
    platform Integer
    i]

    -- | Create a 'CoreExpr' which will evaluate to the given @Int@. Don't check
    -- that the number is in the range of the target platform @Int@
    mkUncheckedIntExpr :: Integer -> CoreExpr        -- Result = I# i :: Int
    mkUncheckedIntExpr :: Integer -> CoreExpr
    mkUncheckedIntExpr Integer
    i = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    intDataCon  [forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitIntUnchecked Integer
    i)]

    -- | Create a 'CoreExpr' which will evaluate to the given @Int@
    mkIntExprInt :: Platform -> Int -> CoreExpr         -- Result = I# i :: Int
    mkIntExprInt :: Platform -> Int -> CoreExpr
    mkIntExprInt Platform
    platform Int
    i = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    intDataCon  [forall b. Platform -> Integer -> Expr b
    mkIntLit Platform
    platform (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i)]

    -- | Create a 'CoreExpr' which will evaluate to the a @Word@ with the given value
    mkWordExpr :: Platform -> Integer -> CoreExpr
    mkWordExpr :: Platform -> Integer -> CoreExpr
    mkWordExpr Platform
    platform Integer
    w = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    wordDataCon [forall b. Platform -> Integer -> Expr b
    mkWordLit Platform
    platform Integer
    w]

    -- | Create a 'CoreExpr' which will evaluate to the given @Integer@
    mkIntegerExpr  :: Integer -> CoreExpr  -- Result :: Integer
    mkIntegerExpr :: Integer -> CoreExpr
    mkIntegerExpr Integer
    i = forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitInteger Integer
    i)

    -- | Create a 'CoreExpr' which will evaluate to the given @Natural@
    mkNaturalExpr  :: Integer -> CoreExpr
    mkNaturalExpr :: Integer -> CoreExpr
    mkNaturalExpr Integer
    i = forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitNatural Integer
    i)

    -- | Create a 'CoreExpr' which will evaluate to the given @Float@
    mkFloatExpr :: Float -> CoreExpr
    mkFloatExpr :: Float -> CoreExpr
    mkFloatExpr Float
    f = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    floatDataCon [forall b. Float -> Expr b
    mkFloatLitFloat Float
    f]

    -- | Create a 'CoreExpr' which will evaluate to the given @Double@
    mkDoubleExpr :: Double -> CoreExpr
    mkDoubleExpr :: Double -> CoreExpr
    mkDoubleExpr Double
    d = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    doubleDataCon [forall b. Double -> Expr b
    mkDoubleLitDouble Double
    d]

    -- | Create a 'CoreExpr' which will evaluate to the given @Char@
    mkCharExpr     :: Char             -> CoreExpr      -- Result = C# c :: Int
    mkCharExpr :: Char -> CoreExpr
    mkCharExpr Char
    c = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    charDataCon [forall b. Char -> Expr b
    mkCharLit Char
    c]

    -- | Create a 'CoreExpr' which will evaluate to the given @String@
    mkStringExpr   :: MonadThings m => String     -> m CoreExpr  -- Result :: String

    -- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@
    mkStringExprFS :: MonadThings m => FastString -> m CoreExpr  -- Result :: String

    mkStringExpr :: forall (m :: * -> *). MonadThings m => String -> m CoreExpr
    mkStringExpr String
    str = forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
    mkStringExprFS (String -> FastString
    mkFastString String
    str)

    mkStringExprFS :: forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
    mkStringExprFS = forall (m :: * -> *).
    Monad m =>
    (Name -> m Id) -> FastString -> m CoreExpr
    mkStringExprFSWith forall (m :: * -> *). MonadThings m => Name -> m Id
    lookupId

    mkStringExprFSWith :: Monad m => (Name -> m Id) -> FastString -> m CoreExpr
    mkStringExprFSWith :: forall (m :: * -> *).
    Monad m =>
    (Name -> m Id) -> FastString -> m CoreExpr
    mkStringExprFSWith Name -> m Id
    lookupM FastString
    str
      | FastString -> Bool
    nullFS FastString
    str
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> CoreExpr
    mkNilExpr Type
    charTy)

      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    safeChar String
    chars
      = do Id
    unpack_id <- Name -> m Id
    lookupM Name
    unpackCStringName
           forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. Expr b -> Expr b -> Expr b
    App (forall b. Id -> Expr b
    Var Id
    unpack_id) CoreExpr
    lit)

      | Bool
    otherwise
      = do Id
    unpack_utf8_id <- Name -> m Id
    lookupM Name
    unpackCStringUtf8Name
           forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. Expr b -> Expr b -> Expr b
    App (forall b. Id -> Expr b
    Var Id
    unpack_utf8_id) CoreExpr
    lit)

      where
        chars :: String
    chars = FastString -> String
    unpackFS FastString
    str
        safeChar :: Char -> Bool
    safeChar Char
    c = Char -> Int
    ord Char
    c forall a. Ord a => a -> a -> Bool
    >= Int
    1 Bool -> Bool -> Bool
    && Char -> Int
    ord Char
    c forall a. Ord a => a -> a -> Bool
    <= Int
    0x7F
        lit :: CoreExpr
    lit = forall b. Literal -> Expr b
    Lit (ByteString -> Literal
    LitString (FastString -> ByteString
    bytesFS FastString
    str))

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Tuple constructors}
    *                                                                      *
    ************************************************************************
    -}

    {-
    Creating tuples and their types for Core expressions

    @mkBigCoreVarTup@ builds a tuple; the inverse to @mkTupleSelector@.

    * If it has only one element, it is the identity function.

    * If there are more elements than a big tuple can have, it nests
      the tuples.

    Note [Flattening one-tuples]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    This family of functions creates a tuple of variables/expressions/types.
      mkCoreTup [e1,e2,e3] = (e1,e2,e3)
    What if there is just one variable/expression/type in the argument?
    We could do one of two things:

    * Flatten it out, so that
        mkCoreTup [e1] = e1

    * Build a one-tuple (see Note [One-tuples] in GHC.Builtin.Types)
        mkCoreTup1 [e1] = Solo e1
      We use a suffix "1" to indicate this.

    Usually we want the former, but occasionally the latter.

    NB: The logic in tupleDataCon knows about () and Solo and (,), etc.

    Note [Don't flatten tuples from HsSyn]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we get an explicit 1-tuple from HsSyn somehow (likely: Template Haskell),
    we should treat it really as a 1-tuple, without flattening. Note that a
    1-tuple and a flattened value have different performance and laziness
    characteristics, so should just do what we're asked.

    This arose from discussions in #16881.

    One-tuples that arise internally depend on the circumstance; often flattening
    is a good idea. Decisions are made on a case-by-case basis.

    -}

    -- | Build the type of a small tuple that holds the specified variables
    -- One-tuples are flattened; see Note [Flattening one-tuples]
    mkCoreVarTupTy :: [Id] -> Type
    mkCoreVarTupTy :: [Id] -> Type
    mkCoreVarTupTy [Id]
    ids = [Type] -> Type
    mkBoxedTupleTy (forall a b. (a -> b) -> [a] -> [b]
    map Id -> Type
    idType [Id]
    ids)

    -- | Build a small tuple holding the specified expressions
    -- One-tuples are flattened; see Note [Flattening one-tuples]
    mkCoreTup :: [CoreExpr] -> CoreExpr
    mkCoreTup :: [CoreExpr] -> CoreExpr
    mkCoreTup [CoreExpr
    c] = CoreExpr
    c
    mkCoreTup [CoreExpr]
    cs  = [CoreExpr] -> CoreExpr
    mkCoreTup1 [CoreExpr]
    cs   -- non-1-tuples are uniform

    -- | Build a small tuple holding the specified expressions
    -- One-tuples are *not* flattened; see Note [Flattening one-tuples]
    -- See also Note [Don't flatten tuples from HsSyn]
    mkCoreTup1 :: [CoreExpr] -> CoreExpr
    mkCoreTup1 :: [CoreExpr] -> CoreExpr
    mkCoreTup1 [CoreExpr]
    cs = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Boxed (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    cs))
                                  (forall a b. (a -> b) -> [a] -> [b]
    map (forall b. Type -> Expr b
    Type forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreExpr -> Type
    exprType) [CoreExpr]
    cs forall a. [a] -> [a] -> [a]
    ++ [CoreExpr]
    cs)

    -- | Build a small unboxed tuple holding the specified expressions,
    -- with the given types. The types must be the types of the expressions.
    -- Do not include the RuntimeRep specifiers; this function calculates them
    -- for you.
    -- Does /not/ flatten one-tuples; see Note [Flattening one-tuples]
    mkCoreUbxTup :: [Type] -> [CoreExpr] -> CoreExpr
    mkCoreUbxTup :: [Type] -> [CoreExpr] -> CoreExpr
    mkCoreUbxTup [Type]
    tys [CoreExpr]
    exps
      = ASSERT( tys `equalLength` exps)
        DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Unboxed (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    tys))
                 (forall a b. (a -> b) -> [a] -> [b]
    map (forall b. Type -> Expr b
    Type forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Type -> Type
    getRuntimeRep) [Type]
    tys forall a. [a] -> [a] -> [a]
    ++ forall a b. (a -> b) -> [a] -> [b]
    map forall b. Type -> Expr b
    Type [Type]
    tys forall a. [a] -> [a] -> [a]
    ++ [CoreExpr]
    exps)

    -- | Make a core tuple of the given boxity; don't flatten 1-tuples
    mkCoreTupBoxity :: Boxity -> [CoreExpr] -> CoreExpr
    mkCoreTupBoxity :: Boxity -> [CoreExpr] -> CoreExpr
    mkCoreTupBoxity Boxity
    Boxed   [CoreExpr]
    exps = [CoreExpr] -> CoreExpr
    mkCoreTup1 [CoreExpr]
    exps
    mkCoreTupBoxity Boxity
    Unboxed [CoreExpr]
    exps = [Type] -> [CoreExpr] -> CoreExpr
    mkCoreUbxTup (forall a b. (a -> b) -> [a] -> [b]
    map CoreExpr -> Type
    exprType [CoreExpr]
    exps) [CoreExpr]
    exps

    -- | Build an unboxed sum.
    --
    -- Alternative number ("alt") starts from 1.
    mkCoreUbxSum :: Int -> Int -> [Type] -> CoreExpr -> CoreExpr
    mkCoreUbxSum :: Int -> Int -> [Type] -> CoreExpr -> CoreExpr
    mkCoreUbxSum Int
    arity Int
    alt [Type]
    tys CoreExpr
    exp
      = ASSERT( length tys == arity )
        ASSERT( alt <= arity )
        DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps (Int -> Int -> DataCon
    sumDataCon Int
    alt Int
    arity)
                      (forall a b. (a -> b) -> [a] -> [b]
    map (forall b. Type -> Expr b
    Type forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Type -> Type
    getRuntimeRep) [Type]
    tys
                       forall a. [a] -> [a] -> [a]
    ++ forall a b. (a -> b) -> [a] -> [b]
    map forall b. Type -> Expr b
    Type [Type]
    tys
                       forall a. [a] -> [a] -> [a]
    ++ [CoreExpr
    exp])

    -- | Build a big tuple holding the specified variables
    -- One-tuples are flattened; see Note [Flattening one-tuples]
    mkBigCoreVarTup :: [Id] -> CoreExpr
    mkBigCoreVarTup :: [Id] -> CoreExpr
    mkBigCoreVarTup [Id]
    ids = [CoreExpr] -> CoreExpr
    mkBigCoreTup (forall a b. (a -> b) -> [a] -> [b]
    map forall b. Id -> Expr b
    Var [Id]
    ids)

    mkBigCoreVarTup1 :: [Id] -> CoreExpr
    -- Same as mkBigCoreVarTup, but one-tuples are NOT flattened
    --                          see Note [Flattening one-tuples]
    mkBigCoreVarTup1 :: [Id] -> CoreExpr
    mkBigCoreVarTup1 [Id
    id] = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Boxed Int
    1)
                                          [forall b. Type -> Expr b
    Type (Id -> Type
    idType Id
    id), forall b. Id -> Expr b
    Var Id
    id]
    mkBigCoreVarTup1 [Id]
    ids  = [CoreExpr] -> CoreExpr
    mkBigCoreTup (forall a b. (a -> b) -> [a] -> [b]
    map forall b. Id -> Expr b
    Var [Id]
    ids)

    -- | Build the type of a big tuple that holds the specified variables
    -- One-tuples are flattened; see Note [Flattening one-tuples]
    mkBigCoreVarTupTy :: [Id] -> Type
    mkBigCoreVarTupTy :: [Id] -> Type
    mkBigCoreVarTupTy [Id]
    ids = [Type] -> Type
    mkBigCoreTupTy (forall a b. (a -> b) -> [a] -> [b]
    map Id -> Type
    idType [Id]
    ids)

    -- | Build a big tuple holding the specified expressions
    -- One-tuples are flattened; see Note [Flattening one-tuples]
    mkBigCoreTup :: [CoreExpr] -> CoreExpr
    mkBigCoreTup :: [CoreExpr] -> CoreExpr
    mkBigCoreTup = forall a. ([a] -> a) -> [a] -> a
    mkChunkified [CoreExpr] -> CoreExpr
    mkCoreTup

    -- | Build the type of a big tuple that holds the specified type of thing
    -- One-tuples are flattened; see Note [Flattening one-tuples]
    mkBigCoreTupTy :: [Type] -> Type
    mkBigCoreTupTy :: [Type] -> Type
    mkBigCoreTupTy = forall a. ([a] -> a) -> [a] -> a
    mkChunkified [Type] -> Type
    mkBoxedTupleTy

    -- | The unit expression
    unitExpr :: CoreExpr
    unitExpr :: CoreExpr
    unitExpr = forall b. Id -> Expr b
    Var Id
    unitDataConId

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Tuple destructors}
    *                                                                      *
    ************************************************************************
    -}

    -- | Builds a selector which scrutises the given
    -- expression and extracts the one name from the list given.
    -- If you want the no-shadowing rule to apply, the caller
    -- is responsible for making sure that none of these names
    -- are in scope.
    --
    -- If there is just one 'Id' in the tuple, then the selector is
    -- just the identity.
    --
    -- If necessary, we pattern match on a \"big\" tuple.
    --
    -- A tuple selector is not linear in its argument. Consequently, the case
    -- expression built by `mkTupleSelector` must consume its scrutinee 'Many'
    -- times. And all the argument variables must have multiplicity 'Many'.
    mkTupleSelector, mkTupleSelector1
        :: [Id]         -- ^ The 'Id's to pattern match the tuple against
        -> Id           -- ^ The 'Id' to select
        -> Id           -- ^ A variable of the same type as the scrutinee
        -> CoreExpr     -- ^ Scrutinee
        -> CoreExpr     -- ^ Selector expression

    -- mkTupleSelector [a,b,c,d] b v e
    --          = case e of v {
    --                (p,q) -> case p of p {
    --                           (a,b) -> b }}
    -- We use 'tpl' vars for the p,q, since shadowing does not matter.
    --
    -- In fact, it's more convenient to generate it innermost first, getting
    --
    --        case (case e of v
    --                (p,q) -> p) of p
    --          (a,b) -> b
    mkTupleSelector :: [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkTupleSelector [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut
      = [[Id]] -> Id -> CoreExpr
    mk_tup_sel (forall a. [a] -> [[a]]
    chunkify [Id]
    vars) Id
    the_var
      where
        mk_tup_sel :: [[Id]] -> Id -> CoreExpr
    mk_tup_sel [[Id]
    vars] Id
    the_var = [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleSelector [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut
        mk_tup_sel [[Id]]
    vars_s Id
    the_var = [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleSelector [Id]
    group Id
    the_var Id
    tpl_v forall a b. (a -> b) -> a -> b
    $
                                    [[Id]] -> Id -> CoreExpr
    mk_tup_sel (forall a. [a] -> [[a]]
    chunkify [Id]
    tpl_vs) Id
    tpl_v
            where
              tpl_tys :: [Type]
    tpl_tys = [[Type] -> Type
    mkBoxedTupleTy (forall a b. (a -> b) -> [a] -> [b]
    map Id -> Type
    idType [Id]
    gp) | [Id]
    gp <- [[Id]]
    vars_s]
              tpl_vs :: [Id]
    tpl_vs  = [Type] -> [Id]
    mkTemplateLocals [Type]
    tpl_tys
              [(Id
    tpl_v, [Id]
    group)] = [(Id
    tpl,[Id]
    gp) | (Id
    tpl,[Id]
    gp) <- forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "mkTupleSelector" [Id]
    tpl_vs [[Id]]
    vars_s,
                                             Id
    the_var forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Id]
    gp ]
    -- ^ 'mkTupleSelector1' is like 'mkTupleSelector'
    -- but one-tuples are NOT flattened (see Note [Flattening one-tuples])
    mkTupleSelector1 :: [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkTupleSelector1 [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut
      | [Id
    _] <- [Id]
    vars
      = [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleSelector1 [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut
      | Bool
    otherwise
      = [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkTupleSelector [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut

    -- | Like 'mkTupleSelector' but for tuples that are guaranteed
    -- never to be \"big\".
    --
    -- > mkSmallTupleSelector [x] x v e = [| e |]
    -- > mkSmallTupleSelector [x,y,z] x v e = [| case e of v { (x,y,z) -> x } |]
    mkSmallTupleSelector, mkSmallTupleSelector1
              :: [Id]        -- The tuple args
              -> Id          -- The selected one
              -> Id          -- A variable of the same type as the scrutinee
              -> CoreExpr    -- Scrutinee
              -> CoreExpr
    mkSmallTupleSelector :: [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleSelector [Id
    var] Id
    should_be_the_same_var Id
    _ CoreExpr
    scrut
      = ASSERT(var == should_be_the_same_var)
        CoreExpr
    scrut  -- Special case for 1-tuples
    mkSmallTupleSelector [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut
      = [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleSelector1 [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut

    -- ^ 'mkSmallTupleSelector1' is like 'mkSmallTupleSelector'
    -- but one-tuples are NOT flattened (see Note [Flattening one-tuples])
    mkSmallTupleSelector1 :: [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleSelector1 [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut
      = ASSERT( notNull vars )
        forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    scrut Id
    scrut_var (Id -> Type
    idType Id
    the_var)
             [forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Boxed (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Id]
    vars))) [Id]
    vars (forall b. Id -> Expr b
    Var Id
    the_var)]

    -- | A generalization of 'mkTupleSelector', allowing the body
    -- of the case to be an arbitrary expression.
    --
    -- To avoid shadowing, we use uniques to invent new variables.
    --
    -- If necessary we pattern match on a \"big\" tuple.
    mkTupleCase :: UniqSupply       -- ^ For inventing names of intermediate variables
                -> [Id]             -- ^ The tuple identifiers to pattern match on
                -> CoreExpr         -- ^ Body of the case
                -> Id               -- ^ A variable of the same type as the scrutinee
                -> CoreExpr         -- ^ Scrutinee
                -> CoreExpr
    -- ToDo: eliminate cases where none of the variables are needed.
    --
    --         mkTupleCase uniqs [a,b,c,d] body v e
    --           = case e of v { (p,q) ->
    --             case p of p { (a,b) ->
    --             case q of q { (c,d) ->
    --             body }}}
    mkTupleCase :: UniqSupply -> [Id] -> CoreExpr -> Id -> CoreExpr -> CoreExpr
    mkTupleCase UniqSupply
    uniqs [Id]
    vars CoreExpr
    body Id
    scrut_var CoreExpr
    scrut
      = UniqSupply -> [[Id]] -> CoreExpr -> CoreExpr
    mk_tuple_case UniqSupply
    uniqs (forall a. [a] -> [[a]]
    chunkify [Id]
    vars) CoreExpr
    body
      where
        -- This is the case where don't need any nesting
        mk_tuple_case :: UniqSupply -> [[Id]] -> CoreExpr -> CoreExpr
    mk_tuple_case UniqSupply
    _ [[Id]
    vars] CoreExpr
    body
          = [Id] -> CoreExpr -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleCase [Id]
    vars CoreExpr
    body Id
    scrut_var CoreExpr
    scrut

        -- This is the case where we must make nest tuples at least once
        mk_tuple_case UniqSupply
    us [[Id]]
    vars_s CoreExpr
    body
          = let (UniqSupply
    us', [Id]
    vars', CoreExpr
    body') = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr [Id]
    -> (UniqSupply, [Id], CoreExpr) -> (UniqSupply, [Id], CoreExpr)
    one_tuple_case (UniqSupply
    us, [], CoreExpr
    body) [[Id]]
    vars_s
                in UniqSupply -> [[Id]] -> CoreExpr -> CoreExpr
    mk_tuple_case UniqSupply
    us' (forall a. [a] -> [[a]]
    chunkify [Id]
    vars') CoreExpr
    body'

        one_tuple_case :: [Id]
    -> (UniqSupply, [Id], CoreExpr) -> (UniqSupply, [Id], CoreExpr)
    one_tuple_case [Id]
    chunk_vars (UniqSupply
    us, [Id]
    vs, CoreExpr
    body)
          = let (Unique
    uniq, UniqSupply
    us') = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply UniqSupply
    us
                scrut_var :: Id
    scrut_var = FastString -> Unique -> Type -> Type -> Id
    mkSysLocal (String -> FastString
    fsLit String
    "ds") Unique
    uniq Type
    Many
                  ([Type] -> Type
    mkBoxedTupleTy (forall a b. (a -> b) -> [a] -> [b]
    map Id -> Type
    idType [Id]
    chunk_vars))
                body' :: CoreExpr
    body' = [Id] -> CoreExpr -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleCase [Id]
    chunk_vars CoreExpr
    body Id
    scrut_var (forall b. Id -> Expr b
    Var Id
    scrut_var)
            in (UniqSupply
    us', Id
    scrut_varforall a. a -> [a] -> [a]
    :[Id]
    vs, CoreExpr
    body')

    -- | As 'mkTupleCase', but for a tuple that is small enough to be guaranteed
    -- not to need nesting.
    mkSmallTupleCase
            :: [Id]         -- ^ The tuple args
            -> CoreExpr     -- ^ Body of the case
            -> Id           -- ^ A variable of the same type as the scrutinee
            -> CoreExpr     -- ^ Scrutinee
            -> CoreExpr

    mkSmallTupleCase :: [Id] -> CoreExpr -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleCase [Id
    var] CoreExpr
    body Id
    _scrut_var CoreExpr
    scrut
      = Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    var CoreExpr
    scrut CoreExpr
    body
    mkSmallTupleCase [Id]
    vars CoreExpr
    body Id
    scrut_var CoreExpr
    scrut
    -- One branch no refinement?
      = forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
    Case CoreExpr
    scrut Id
    scrut_var (CoreExpr -> Type
    exprType CoreExpr
    body)
             [forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Boxed (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Id]
    vars))) [Id]
    vars CoreExpr
    body]

    {-
    ************************************************************************
    *                                                                      *
                    Floats
    *                                                                      *
    ************************************************************************
    -}

    data FloatBind
      = FloatLet  CoreBind
      | FloatCase CoreExpr Id AltCon [Var]
          -- case e of y { C ys -> ... }
          -- See Note [Floating single-alternative cases] in GHC.Core.Opt.SetLevels

    instance Outputable FloatBind where
      ppr :: FloatBind -> SDoc
    ppr (FloatLet CoreBind
    b) = String -> SDoc
    text String
    "LET" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr CoreBind
    b
      ppr (FloatCase CoreExpr
    e Id
    b AltCon
    c [Id]
    bs) = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "CASE" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e SDoc -> SDoc -> SDoc
    <+> PtrString -> SDoc
    ptext (String -> PtrString
    sLit String
    "of") SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Id
    b)
                                    Int
    2 (forall a. Outputable a => a -> SDoc
    ppr AltCon
    c SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr [Id]
    bs)

    wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
    wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
    wrapFloat (FloatLet CoreBind
    defns)       CoreExpr
    body = forall b. Bind b -> Expr b -> Expr b
    Let CoreBind
    defns CoreExpr
    body
    wrapFloat (FloatCase CoreExpr
    e Id
    b AltCon
    con [Id]
    bs) CoreExpr
    body = CoreExpr -> Id -> AltCon -> [Id] -> CoreExpr -> CoreExpr
    mkSingleAltCase CoreExpr
    e Id
    b AltCon
    con [Id]
    bs CoreExpr
    body

    -- | Applies the floats from right to left. That is @wrapFloats [b1, b2, …, bn]
    -- u = let b1 in let b2 in … in let bn in u@
    wrapFloats :: [FloatBind] -> CoreExpr -> CoreExpr
    wrapFloats :: [FloatBind] -> CoreExpr -> CoreExpr
    wrapFloats [FloatBind]
    floats CoreExpr
    expr = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr FloatBind -> CoreExpr -> CoreExpr
    wrapFloat CoreExpr
    expr [FloatBind]
    floats

    bindBindings :: CoreBind -> [Var]
    bindBindings :: CoreBind -> [Id]
    bindBindings (NonRec Id
    b CoreExpr
    _) = [Id
    b]
    bindBindings (Rec [(Id, CoreExpr)]
    bnds) = forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(Id, CoreExpr)]
    bnds

    floatBindings :: FloatBind -> [Var]
    floatBindings :: FloatBind -> [Id]
    floatBindings (FloatLet CoreBind
    bnd) = CoreBind -> [Id]
    bindBindings CoreBind
    bnd
    floatBindings (FloatCase CoreExpr
    _ Id
    b AltCon
    _ [Id]
    bs) = Id
    bforall a. a -> [a] -> [a]
    :[Id]
    bs

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Common list manipulation expressions}
    *                                                                      *
    ************************************************************************

    Call the constructor Ids when building explicit lists, so that they
    interact well with rules.
    -}

    -- | Makes a list @[]@ for lists of the specified type
    mkNilExpr :: Type -> CoreExpr
    mkNilExpr :: Type -> CoreExpr
    mkNilExpr Type
    ty = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    nilDataCon [forall b. Type -> Expr b
    Type Type
    ty]

    -- | Makes a list @(:)@ for lists of the specified type
    mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr
    mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr
    mkConsExpr Type
    ty CoreExpr
    hd CoreExpr
    tl = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    consDataCon [forall b. Type -> Expr b
    Type Type
    ty, CoreExpr
    hd, CoreExpr
    tl]

    -- | Make a list containing the given expressions, where the list has the given type
    mkListExpr :: Type -> [CoreExpr] -> CoreExpr
    mkListExpr :: Type -> [CoreExpr] -> CoreExpr
    mkListExpr Type
    ty [CoreExpr]
    xs = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Type -> CoreExpr -> CoreExpr -> CoreExpr
    mkConsExpr Type
    ty) (Type -> CoreExpr
    mkNilExpr Type
    ty) [CoreExpr]
    xs

    mkNonEmptyListExpr :: Type -> CoreExpr -> [CoreExpr] -> CoreExpr
    mkNonEmptyListExpr :: Type -> CoreExpr -> [CoreExpr] -> CoreExpr
    mkNonEmptyListExpr Type
    ty CoreExpr
    x [CoreExpr]
    xs = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    nonEmptyDataCon [forall b. Type -> Expr b
    Type Type
    ty, CoreExpr
    x, Type -> [CoreExpr] -> CoreExpr
    mkListExpr Type
    ty [CoreExpr]
    xs]

    -- | Make a fully applied 'foldr' expression
    mkFoldrExpr :: MonadThings m
                => Type             -- ^ Element type of the list
                -> Type             -- ^ Fold result type
                -> CoreExpr         -- ^ "Cons" function expression for the fold
                -> CoreExpr         -- ^ "Nil" expression for the fold
                -> CoreExpr         -- ^ List expression being folded acress
                -> m CoreExpr
    mkFoldrExpr :: forall (m :: * -> *).
    MonadThings m =>
    Type -> Type -> CoreExpr -> CoreExpr -> CoreExpr -> m CoreExpr
    mkFoldrExpr Type
    elt_ty Type
    result_ty CoreExpr
    c CoreExpr
    n CoreExpr
    list = do
        Id
    foldr_id <- forall (m :: * -> *). MonadThings m => Name -> m Id
    lookupId Name
    foldrName
        forall (m :: * -> *) a. Monad m => a -> m a
    return (forall b. Id -> Expr b
    Var Id
    foldr_id forall b. Expr b -> Expr b -> Expr b
    `App` forall b. Type -> Expr b
    Type Type
    elt_ty
               forall b. Expr b -> Expr b -> Expr b
    `App` forall b. Type -> Expr b
    Type Type
    result_ty
               forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    c
               forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    n
               forall b. Expr b -> Expr b -> Expr b
    `App` CoreExpr
    list)

    -- | Make a 'build' expression applied to a locally-bound worker function
    mkBuildExpr :: (MonadFail m, MonadThings m, MonadUnique m)
                => Type                                     -- ^ Type of list elements to be built
                -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's
                                                            -- of the binders for the build worker function, returns
                                                            -- the body of that worker
                -> m CoreExpr
    mkBuildExpr :: forall (m :: * -> *).
    (MonadFail m, MonadThings m, MonadUnique m) =>
    Type -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -> m CoreExpr
    mkBuildExpr Type
    elt_ty (Id, Type) -> (Id, Type) -> m CoreExpr
    mk_build_inside = do
        Id
    n_tyvar <- forall {m :: * -> *}. MonadUnique m => Id -> m Id
    newTyVar Id
    alphaTyVar
        let n_ty :: Type
    n_ty = Id -> Type
    mkTyVarTy Id
    n_tyvar
            c_ty :: Type
    c_ty = [Type] -> Type -> Type
    mkVisFunTysMany [Type
    elt_ty, Type
    n_ty] Type
    n_ty
        [Id
    c, Id
    n] <- forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Type -> Type -> m Id
    mkSysLocalM (String -> FastString
    fsLit String
    "c") Type
    Many Type
    c_ty, forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Type -> Type -> m Id
    mkSysLocalM (String -> FastString
    fsLit String
    "n") Type
    Many Type
    n_ty]

        CoreExpr
    build_inside <- (Id, Type) -> (Id, Type) -> m CoreExpr
    mk_build_inside (Id
    c, Type
    c_ty) (Id
    n, Type
    n_ty)

        Id
    build_id <- forall (m :: * -> *). MonadThings m => Name -> m Id
    lookupId Name
    buildName
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall b. Id -> Expr b
    Var Id
    build_id forall b. Expr b -> Expr b -> Expr b
    `App` forall b. Type -> Expr b
    Type Type
    elt_ty forall b. Expr b -> Expr b -> Expr b
    `App` forall b. [b] -> Expr b -> Expr b
    mkLams [Id
    n_tyvar, Id
    c, Id
    n] CoreExpr
    build_inside
      where
        newTyVar :: Id -> m Id
    newTyVar Id
    tyvar_tmpl = do
          Unique
    uniq <- forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
          forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> Unique -> Id
    setTyVarUnique Id
    tyvar_tmpl Unique
    uniq)

    {-
    ************************************************************************
    *                                                                      *
                 Manipulating Maybe data type
    *                                                                      *
    ************************************************************************
    -}

    -- | Makes a Nothing for the specified type
    mkNothingExpr :: Type -> CoreExpr
    mkNothingExpr :: Type -> CoreExpr
    mkNothingExpr Type
    ty = forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    nothingDataCon [forall b. Type -> Expr b
    Type Type
    ty]

    -- | Makes a Just from a value of the specified type
    mkJustExpr :: Type -> CoreExpr -> CoreExpr
    mkJustExpr :: Type -> CoreExpr -> CoreExpr
    mkJustExpr Type
    ty CoreExpr
    val = forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    justDataCon [forall b. Type -> Expr b
    Type Type
    ty, CoreExpr
    val]

    {-
    ************************************************************************
    *                                                                      *
                          Error expressions
    *                                                                      *
    ************************************************************************
    -}

    mkRuntimeErrorApp
            :: Id           -- Should be of type (forall a. Addr# -> a)
                            --      where Addr# points to a UTF8 encoded string
            -> Type         -- The type to instantiate 'a'
            -> String       -- The string to print
            -> CoreExpr

    mkRuntimeErrorApp :: Id -> Type -> String -> CoreExpr
    mkRuntimeErrorApp Id
    err_id Type
    res_ty String
    err_msg
      = forall b. Expr b -> [Expr b] -> Expr b
    mkApps (forall b. Id -> Expr b
    Var Id
    err_id) [ forall b. Type -> Expr b
    Type (HasDebugCallStack => Type -> Type
    getRuntimeRep Type
    res_ty)
                            , forall b. Type -> Expr b
    Type Type
    res_ty, CoreExpr
    err_string ]
      where
        err_string :: CoreExpr
    err_string = forall b. Literal -> Expr b
    Lit (String -> Literal
    mkLitString String
    err_msg)

    mkImpossibleExpr :: Type -> CoreExpr
    mkImpossibleExpr :: Type -> CoreExpr
    mkImpossibleExpr Type
    res_ty
      = Id -> Type -> String -> CoreExpr
    mkRuntimeErrorApp Id
    rUNTIME_ERROR_ID Type
    res_ty String
    "Impossible case alternative"

    {-
    ************************************************************************
    *                                                                      *
                         Error Ids
    *                                                                      *
    ************************************************************************

    GHC randomly injects these into the code.

    @patError@ is just a version of @error@ for pattern-matching
    failures.  It knows various ``codes'' which expand to longer
    strings---this saves space!

    @absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
    well shouldn't be yanked on, but if one is, then you will get a
    friendly message from @absentErr@ (rather than a totally random
    crash).

    @parError@ is a special version of @error@ which the compiler does
    not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
    templates, but we don't ever expect to generate code for it.
    -}

    errorIds :: [Id]
    errorIds :: [Id]
    errorIds
      = [ Id
    rUNTIME_ERROR_ID,
          Id
    nON_EXHAUSTIVE_GUARDS_ERROR_ID,
          Id
    nO_METHOD_BINDING_ERROR_ID,
          Id
    pAT_ERROR_ID,
          Id
    rEC_CON_ERROR_ID,
          Id
    rEC_SEL_ERROR_ID,
          Id
    aBSENT_ERROR_ID,
          Id
    aBSENT_SUM_FIELD_ERROR_ID,
          Id
    tYPE_ERROR_ID,   -- Used with Opt_DeferTypeErrors, see #10284
          Id
    rAISE_OVERFLOW_ID,
          Id
    rAISE_UNDERFLOW_ID,
          Id
    rAISE_DIVZERO_ID
          ]

    recSelErrorName, runtimeErrorName, absentErrorName :: Name
    recConErrorName, patErrorName :: Name
    nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name
    typeErrorName :: Name
    absentSumFieldErrorName :: Name
    raiseOverflowName, raiseUnderflowName, raiseDivZeroName :: Name

    recSelErrorName :: Name
    recSelErrorName     = String -> Unique -> Id -> Name
    err_nm String
    "recSelError"     Unique
    recSelErrorIdKey     Id
    rEC_SEL_ERROR_ID
    runtimeErrorName :: Name
    runtimeErrorName    = String -> Unique -> Id -> Name
    err_nm String
    "runtimeError"    Unique
    runtimeErrorIdKey    Id
    rUNTIME_ERROR_ID
    recConErrorName :: Name
    recConErrorName     = String -> Unique -> Id -> Name
    err_nm String
    "recConError"     Unique
    recConErrorIdKey     Id
    rEC_CON_ERROR_ID
    patErrorName :: Name
    patErrorName        = String -> Unique -> Id -> Name
    err_nm String
    "patError"        Unique
    patErrorIdKey        Id
    pAT_ERROR_ID
    typeErrorName :: Name
    typeErrorName       = String -> Unique -> Id -> Name
    err_nm String
    "typeError"       Unique
    typeErrorIdKey       Id
    tYPE_ERROR_ID

    noMethodBindingErrorName :: Name
    noMethodBindingErrorName     = String -> Unique -> Id -> Name
    err_nm String
    "noMethodBindingError"
                                      Unique
    noMethodBindingErrorIdKey Id
    nO_METHOD_BINDING_ERROR_ID
    nonExhaustiveGuardsErrorName :: Name
    nonExhaustiveGuardsErrorName = String -> Unique -> Id -> Name
    err_nm String
    "nonExhaustiveGuardsError"
                                      Unique
    nonExhaustiveGuardsErrorIdKey Id
    nON_EXHAUSTIVE_GUARDS_ERROR_ID

    err_nm :: String -> Unique -> Id -> Name
    err_nm :: String -> Unique -> Id -> Name
    err_nm String
    str Unique
    uniq Id
    id = Module -> FastString -> Unique -> Id -> Name
    mkWiredInIdName Module
    cONTROL_EXCEPTION_BASE (String -> FastString
    fsLit String
    str) Unique
    uniq Id
    id

    rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, rEC_CON_ERROR_ID :: Id
    pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
    tYPE_ERROR_ID, aBSENT_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID :: Id
    rAISE_OVERFLOW_ID, rAISE_UNDERFLOW_ID, rAISE_DIVZERO_ID :: Id
    rEC_SEL_ERROR_ID :: Id
    rEC_SEL_ERROR_ID                = Name -> Id
    mkRuntimeErrorId Name
    recSelErrorName
    rUNTIME_ERROR_ID :: Id
    rUNTIME_ERROR_ID                = Name -> Id
    mkRuntimeErrorId Name
    runtimeErrorName
    rEC_CON_ERROR_ID :: Id
    rEC_CON_ERROR_ID                = Name -> Id
    mkRuntimeErrorId Name
    recConErrorName
    pAT_ERROR_ID :: Id
    pAT_ERROR_ID                    = Name -> Id
    mkRuntimeErrorId Name
    patErrorName
    nO_METHOD_BINDING_ERROR_ID :: Id
    nO_METHOD_BINDING_ERROR_ID      = Name -> Id
    mkRuntimeErrorId Name
    noMethodBindingErrorName
    nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
    nON_EXHAUSTIVE_GUARDS_ERROR_ID  = Name -> Id
    mkRuntimeErrorId Name
    nonExhaustiveGuardsErrorName
    tYPE_ERROR_ID :: Id
    tYPE_ERROR_ID                   = Name -> Id
    mkRuntimeErrorId Name
    typeErrorName

    -- Note [aBSENT_SUM_FIELD_ERROR_ID]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- Unboxed sums are transformed into unboxed tuples in GHC.Stg.Unarise.mkUbxSum
    -- and fields that can't be reached are filled with rubbish values. It's easy to
    -- come up with rubbish literal values: we use 0 (ints/words) and 0.0
    -- (floats/doubles). Coming up with a rubbish pointer value is more delicate:
    --
    --    1. it needs to be a valid closure pointer for the GC (not a NULL pointer)
    --
    --    2. it is never used in Core, only in STG; and even then only for filling a
    --       GC-ptr slot in an unboxed sum (see GHC.Stg.Unarise.ubxSumRubbishArg).
    --       So all we need is a pointer, and its levity doesn't matter. Hence we
    --       can safely give it the (lifted) type:
    --
    --             absentSumFieldError :: forall a. a
    --
    --       despite the fact that Unarise might instantiate it at non-lifted
    --       types.
    --
    --    3. it can't take arguments because it's used in unarise and applying an
    --       argument would require allocating a thunk.
    --
    --    4. it can't be CAFFY because that would mean making some non-CAFFY
    --       definitions that use unboxed sums CAFFY in unarise. We work around
    --       this by declaring the absentSumFieldError as non-CAFfy, as described
    --       in Note [Wired-in exceptions are not CAFfy].
    --
    --       Getting this wrong causes hard-to-debug runtime issues, see #15038.
    --
    --    5. it can't be defined in `base` package.
    --
    --       Defining `absentSumFieldError` in `base` package introduces a
    --       dependency on `base` for any code using unboxed sums. It became an
    --       issue when we wanted to use unboxed sums in boot libraries used by
    --       `base`, see #17791.
    --
    --
    -- * Most runtime-error functions throw a proper Haskell exception, which can be
    --   caught in the usual way. But these functions are defined in
    --   `base:Control.Exception.Base`, hence, they cannot be directly invoked in
    --   any library compiled before `base`.  Only exceptions that have been wired
    --   in the RTS can be thrown (indirectly, via a call into the RTS) by libraries
    --   compiled before `base`.
    --
    --   However wiring exceptions in the RTS is a bit annoying because we need to
    --   explicitly import exception closures via their mangled symbol name (e.g.
    --   `import CLOSURE base_GHCziIOziException_heapOverflow_closure`) in Cmm files
    --   and every imported symbol must be indicated to the linker in a few files
    --   (`package.conf`, `rts.cabal`, `win32/libHSbase.def`, `Prelude.h`...). It
    --   explains why exceptions are only wired in the RTS when necessary.
    --
    -- * `absentSumFieldError` is defined in ghc-prim:GHC.Prim.Panic, hence, it can
    --   be invoked in libraries compiled before `base`. It does not throw a Haskell
    --   exception; instead, it calls `stg_panic#`, which immediately halts
    --   execution.  A runtime invocation of `absentSumFieldError` indicates a GHC
    --   bug. Unlike (say) pattern-match errors, it cannot be caused by a user
    --   error. That's why it is OK for it to be un-catchable.
    --

    -- Note [Wired-in exceptions are not CAFfy]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- mkExceptionId claims that all exceptions are not CAFfy, despite the fact
    -- that their closures' code may in fact contain CAF references. We get away
    -- with this lie because the RTS ensures that all exception closures are
    -- considered live by the GC by creating StablePtrs during initialization.
    -- The lie is necessary to avoid unduly growing SRTs as these exceptions are
    -- sufficiently common to warrant special treatment.
    --
    -- At some point we could consider removing this optimisation as it is quite
    -- fragile, but we do want to be careful to avoid adding undue cost. Unboxed
    -- sums in particular are intended to be used in performance-critical contexts.
    --
    -- See #15038, #21141.

    absentSumFieldErrorName :: Name
    absentSumFieldErrorName
       = Module -> FastString -> Unique -> Id -> Name
    mkWiredInIdName
          Module
    gHC_PRIM_PANIC
          (String -> FastString
    fsLit String
    "absentSumFieldError")
          Unique
    absentSumFieldErrorIdKey
          Id
    aBSENT_SUM_FIELD_ERROR_ID

    absentErrorName :: Name
    absentErrorName
       = Module -> FastString -> Unique -> Id -> Name
    mkWiredInIdName
          Module
    gHC_PRIM_PANIC
          (String -> FastString
    fsLit String
    "absentError")
          Unique
    absentErrorIdKey
          Id
    aBSENT_ERROR_ID

    raiseOverflowName :: Name
    raiseOverflowName
       = Module -> FastString -> Unique -> Id -> Name
    mkWiredInIdName
          Module
    gHC_PRIM_EXCEPTION
          (String -> FastString
    fsLit String
    "raiseOverflow")
          Unique
    raiseOverflowIdKey
          Id
    rAISE_OVERFLOW_ID

    raiseUnderflowName :: Name
    raiseUnderflowName
       = Module -> FastString -> Unique -> Id -> Name
    mkWiredInIdName
          Module
    gHC_PRIM_EXCEPTION
          (String -> FastString
    fsLit String
    "raiseUnderflow")
          Unique
    raiseUnderflowIdKey
          Id
    rAISE_UNDERFLOW_ID

    raiseDivZeroName :: Name
    raiseDivZeroName
       = Module -> FastString -> Unique -> Id -> Name
    mkWiredInIdName
          Module
    gHC_PRIM_EXCEPTION
          (String -> FastString
    fsLit String
    "raiseDivZero")
          Unique
    raiseDivZeroIdKey
          Id
    rAISE_DIVZERO_ID

    aBSENT_SUM_FIELD_ERROR_ID :: Id
    aBSENT_SUM_FIELD_ERROR_ID = Name -> Id
    mkExceptionId Name
    absentSumFieldErrorName
    rAISE_OVERFLOW_ID :: Id
    rAISE_OVERFLOW_ID         = Name -> Id
    mkExceptionId Name
    raiseOverflowName
    rAISE_UNDERFLOW_ID :: Id
    rAISE_UNDERFLOW_ID        = Name -> Id
    mkExceptionId Name
    raiseUnderflowName
    rAISE_DIVZERO_ID :: Id
    rAISE_DIVZERO_ID          = Name -> Id
    mkExceptionId Name
    raiseDivZeroName

    -- | Exception with type \"forall a. a\"
    --
    -- Any exceptions added via this function needs to be added to
    -- the RTS's initBuiltinGcRoots() function.
    mkExceptionId :: Name -> Id
    mkExceptionId :: Name -> Id
    mkExceptionId Name
    name
      = Name -> Type -> IdInfo -> Id
    mkVanillaGlobalWithInfo Name
    name
          ([Id] -> Type -> Type
    mkSpecForAllTys [Id
    alphaTyVar] (Id -> Type
    mkTyVarTy Id
    alphaTyVar)) -- forall a . a
          (IdInfo
    vanillaIdInfo IdInfo -> StrictSig -> IdInfo
    `setStrictnessInfo` [Demand] -> Divergence -> StrictSig
    mkClosedStrictSig [] Divergence
    botDiv
                         IdInfo -> CprSig -> IdInfo
    `setCprInfo` Int -> Cpr -> CprSig
    mkCprSig Int
    0 Cpr
    botCpr
                         IdInfo -> Int -> IdInfo
    `setArityInfo` Int
    0
                         IdInfo -> CafInfo -> IdInfo
    `setCafInfo` CafInfo
    NoCafRefs)
                            -- See Note [Wired-in exceptions are not CAFfy]

    mkRuntimeErrorId :: Name -> Id
    -- Error function
    --   with type:  forall (r:RuntimeRep) (a:TYPE r). Addr# -> a
    --   with arity: 1
    -- which diverges after being given one argument
    -- The Addr# is expected to be the address of
    --   a UTF8-encoded error string
    mkRuntimeErrorId :: Name -> Id
    mkRuntimeErrorId Name
    name
     = Name -> Type -> IdInfo -> Id
    mkVanillaGlobalWithInfo Name
    name Type
    runtimeErrorTy IdInfo
    bottoming_info
     where
        bottoming_info :: IdInfo
    bottoming_info = IdInfo
    vanillaIdInfo IdInfo -> StrictSig -> IdInfo
    `setStrictnessInfo`    StrictSig
    strict_sig
                                       IdInfo -> CprSig -> IdInfo
    `setCprInfo`           Int -> Cpr -> CprSig
    mkCprSig Int
    1 Cpr
    botCpr
                                       IdInfo -> Int -> IdInfo
    `setArityInfo`         Int
    1
                            -- Make arity and strictness agree

            -- Do *not* mark them as NoCafRefs, because they can indeed have
            -- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,
            -- which has some CAFs
            -- In due course we may arrange that these error-y things are
            -- regarded by the GC as permanently live, in which case we
            -- can give them NoCaf info.  As it is, any function that calls
            -- any pc_bottoming_Id will itself have CafRefs, which bloats
            -- SRTs.

        strict_sig :: StrictSig
    strict_sig = [Demand] -> Divergence -> StrictSig
    mkClosedStrictSig [Demand
    evalDmd] Divergence
    botDiv

    runtimeErrorTy :: Type
    -- forall (rr :: RuntimeRep) (a :: rr). Addr# -> a
    --   See Note [Error and friends have an "open-tyvar" forall]
    runtimeErrorTy :: Type
    runtimeErrorTy = [Id] -> Type -> Type
    mkSpecForAllTys [Id
    runtimeRep1TyVar, Id
    openAlphaTyVar]
                                     (Type -> Type -> Type
    mkVisFunTyMany Type
    addrPrimTy Type
    openAlphaTy)

    {- Note [Error and friends have an "open-tyvar" forall]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'error' and 'undefined' have types
            error     :: forall (v :: RuntimeRep) (a :: TYPE v). String -> a
            undefined :: forall (v :: RuntimeRep) (a :: TYPE v). a
    Notice the runtime-representation polymorphism. This ensures that
    "error" can be instantiated at unboxed as well as boxed types.
    This is OK because it never returns, so the return type is irrelevant.

    ************************************************************************
    *                                                                      *
                         aBSENT_ERROR_ID
    *                                                                      *
    ************************************************************************

    Note [aBSENT_ERROR_ID]
    ~~~~~~~~~~~~~~~~~~~~~~
    We use aBSENT_ERROR_ID to build dummy values in workers.  E.g.

       f x = (case x of (a,b) -> b) + 1::Int

    The demand analyser figures out that only the second component of x is
    used, and does a w/w split thus

       f x = case x of (a,b) -> $wf b

       $wf b = let a = absentError "blah"
                   x = (a,b)
               in <the original RHS of f>

    After some simplification, the (absentError "blah") thunk goes away.

    ------ Tricky wrinkle -------
    #14285 had, roughly

       data T a = MkT a !a
       {-# INLINABLE f #-}
       f x = case x of MkT a b -> g (MkT b a)

    It turned out that g didn't use the second component, and hence f doesn't use
    the first.  But the stable-unfolding for f looks like
       \x. case x of MkT a b -> g ($WMkT b a)
    where $WMkT is the wrapper for MkT that evaluates its arguments.  We
    apply the same w/w split to this unfolding (see Note [Worker-wrapper
    for INLINEABLE functions] in GHC.Core.Opt.WorkWrap) so the template ends up like
       \b. let a = absentError "blah"
               x = MkT a b
            in case x of MkT a b -> g ($WMkT b a)

    After doing case-of-known-constructor, and expanding $WMkT we get
       \b -> g (case absentError "blah" of a -> MkT b a)

    Yikes!  That bogusly appears to evaluate the absentError!

    This is extremely tiresome.  Another way to think of this is that, in
    Core, it is an invariant that a strict data constructor, like MkT, must
    be applied only to an argument in HNF. So (absentError "blah") had
    better be non-bottom.

    So the "solution" is to add a special case for absentError to exprIsHNFlike.
    This allows Simplify.rebuildCase, in the Note [Case to let transformation]
    branch, to convert the case on absentError into a let. We also make
    absentError *not* be diverging, unlike the other error-ids, so that we
    can be sure not to remove the case branches before converting the case to
    a let.

    If, by some bug or bizarre happenstance, we ever call absentError, we should
    throw an exception.  This should never happen, of course, but we definitely
    can't return anything.  e.g. if somehow we had
        case absentError "foo" of
           Nothing -> ...
           Just x  -> ...
    then if we return, the case expression will select a field and continue.
    Seg fault city. Better to throw an exception. (Even though we've said
    it is in HNF :-)

    It might seem a bit surprising that seq on absentError is simply erased

        absentError "foo" `seq` x ==> x

    but that should be okay; since there's no pattern match we can't really
    be relying on anything from it.
    -}

    aBSENT_ERROR_ID :: Id
    aBSENT_ERROR_ID
     = Name -> Type -> IdInfo -> Id
    mkVanillaGlobalWithInfo Name
    absentErrorName Type
    absent_ty IdInfo
    arity_info
     where
       absent_ty :: Type
    absent_ty = [Id] -> Type -> Type
    mkSpecForAllTys [Id
    alphaTyVar] (Type -> Type -> Type
    mkVisFunTyMany Type
    addrPrimTy Type
    alphaTy)
       -- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for
       -- lifted-type things; see Note [Absent fillers] in GHC.Core.Opt.WorkWrap.Utils
       arity_info :: IdInfo
    arity_info = IdInfo
    vanillaIdInfo IdInfo -> Int -> IdInfo
    `setArityInfo` Int
    1
       -- NB: no bottoming strictness info, unlike other error-ids.
       -- See Note [aBSENT_ERROR_ID]

    mkAbsentErrorApp :: Type         -- The type to instantiate 'a'
                     -> String       -- The string to print
                     -> CoreExpr

    mkAbsentErrorApp :: Type -> String -> CoreExpr
    mkAbsentErrorApp Type
    res_ty String
    err_msg
      = forall b. Expr b -> [Expr b] -> Expr b
    mkApps (forall b. Id -> Expr b
    Var Id
    aBSENT_ERROR_ID) [ forall b. Type -> Expr b
    Type Type
    res_ty, CoreExpr
    err_string ]
      where
        err_string :: CoreExpr
    err_string = forall b. Literal -> Expr b
    Lit (String -> Literal
    mkLitString String
    err_msg)