    {-# 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,
            mkSingleAltCase,
            sortQuantVars, castBottomExpr,

            -- * Constructing boxed literals
            mkLitRubbish,
            mkWordExpr,
            mkIntExpr, mkIntExprInt, mkUncheckedIntExpr,
            mkIntegerExpr, mkNaturalExpr,
            mkFloatExpr, mkDoubleExpr,
            mkCharExpr, mkStringExpr, mkStringExprFS, mkStringExprFSWith,
            MkStringIds (..), getMkStringIds,

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

            -- * Constructing small tuples
            mkCoreVarTupTy, mkCoreTup, mkCoreUnboxedTuple, mkCoreUnboxedSum,
            mkCoreTupBoxity, unitExpr,

            -- * Constructing big tuples
            mkChunkified, chunkify,
            mkBigCoreVarTup, mkBigCoreVarTupSolo,
            mkBigCoreVarTupTy, mkBigCoreTupTy,
            mkBigCoreTup,

              -- * Deconstructing big tuples
            mkBigTupleSelector, mkBigTupleSelectorSolo, mkBigTupleCase,

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

            -- * Constructing Maybe expressions
            mkNothingExpr, mkJustExpr,

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

    import GHC.Prelude
    import GHC.Platform

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

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

    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.Settings.Constants( mAX_TUPLE_SIZE )
    import GHC.Data.FastString

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

    infixl 4 `mkCoreApp`, `mkCoreApps`

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Basic GHC.Core construction}
    *                                                                      *
    ************************************************************************
    -}
    -- | Sort the variables, putting type and covars first, in scoped order,
    -- and then other Ids
    --
    -- It is a deterministic sort, meaning it doesn't look at the values of
    -- Uniques. For explanation why it's important See Note [Unique Determinism]
    -- in GHC.Types.Unique.
    sortQuantVars :: [Var] -> [Var]
    sortQuantVars :: [Id] -> [Id]
    sortQuantVars [Id]
    vs = [Id]
    sorted_tcvs [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id]
    ids
      where
        ([Id]
    tcvs, [Id]
    ids) = (Id -> Bool) -> [Id] -> ([Id], [Id])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Id -> Bool
    isTyVar (Id -> Bool) -> (Id -> Bool) -> Id -> Bool
    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_can_float_invariant")
    mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr
    mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr
    mkCoreLet (NonRec Id
    bndr CoreExpr
    rhs) CoreExpr
    body        -- See Note [Core let-can-float invariant]
      = HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr
    Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    bndr CoreExpr
    rhs CoreExpr
    body
    mkCoreLet CoreBind
    bind CoreExpr
    body
      = CoreBind -> CoreExpr -> CoreExpr
    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 = [Id] -> CoreExpr -> CoreExpr
    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 = (CoreBind -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [CoreBind] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    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 (Id -> CoreExpr
    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
    mkCoreApps :: CoreExpr -- ^ function
               -> [CoreExpr] -- ^ arguments
               -> CoreExpr
    mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr
    mkCoreApps CoreExpr
    fun [CoreExpr]
    args
      = (CoreExpr, Kind) -> CoreExpr
    forall a b. (a, b) -> a
    fst ((CoreExpr, Kind) -> CoreExpr) -> (CoreExpr, Kind) -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        ((CoreExpr, Kind) -> CoreExpr -> (CoreExpr, Kind))
    -> (CoreExpr, Kind) -> [CoreExpr] -> (CoreExpr, Kind)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (SDoc -> (CoreExpr, Kind) -> CoreExpr -> (CoreExpr, Kind)
    mkCoreAppTyped SDoc
    doc_string) (CoreExpr
    fun, Kind
    fun_ty) [CoreExpr]
    args
      where
        doc_string :: SDoc
    doc_string = Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    fun_ty SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    fun SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    args
        fun_ty :: Kind
    fun_ty = HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    fun

    -- | Construct an expression which represents the application of one expression
    -- to the other
    mkCoreApp :: SDoc
              -> CoreExpr -- ^ function
              -> CoreExpr -- ^ argument
              -> CoreExpr
    mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
    mkCoreApp SDoc
    s CoreExpr
    fun CoreExpr
    arg
      = (CoreExpr, Kind) -> CoreExpr
    forall a b. (a, b) -> a
    fst ((CoreExpr, Kind) -> CoreExpr) -> (CoreExpr, Kind) -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ SDoc -> (CoreExpr, Kind) -> CoreExpr -> (CoreExpr, Kind)
    mkCoreAppTyped SDoc
    s (CoreExpr
    fun, HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    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'.
    mkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)
    mkCoreAppTyped :: SDoc -> (CoreExpr, Kind) -> CoreExpr -> (CoreExpr, Kind)
    mkCoreAppTyped SDoc
    _ (CoreExpr
    fun, Kind
    fun_ty) (Type Kind
    ty)
      = (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun (Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type Kind
    ty), HasDebugCallStack => Kind -> Kind -> Kind
    Kind -> Kind -> Kind
    piResultTy Kind
    fun_ty Kind
    ty)
    mkCoreAppTyped SDoc
    _ (CoreExpr
    fun, Kind
    fun_ty) (Coercion Coercion
    co)
      = (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun (Coercion -> CoreExpr
    forall b. Coercion -> Expr b
    Coercion Coercion
    co), HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    funResultTy Kind
    fun_ty)
    mkCoreAppTyped SDoc
    d (CoreExpr
    fun, Kind
    fun_ty) CoreExpr
    arg
      = Bool -> SDoc -> (CoreExpr, Kind) -> (CoreExpr, Kind)
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Kind -> Bool
    isFunTy Kind
    fun_ty) (CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    fun SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    arg SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc
    d)
        (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun CoreExpr
    arg, HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    funResultTy Kind
    fun_ty)

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

    -- | 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 :: Kind -> Kind -> Id
    mkWildValBinder Kind
    w Kind
    ty = Name -> Kind -> Kind -> Id
    mkLocalIdOrCoVar Name
    wildCardName Kind
    w Kind
    ty
      -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors
      -- (e.g. see test T15695). Ticket #17291 covers fixing this problem.

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

    mkIfThenElse :: CoreExpr -- ^ guard
                 -> CoreExpr -- ^ then
                 -> CoreExpr -- ^ else
                 -> 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 Kind -> Kind -> [CoreAlt] -> CoreExpr
    mkWildCase CoreExpr
    guard (Kind -> Scaled Kind
    forall a. a -> Scaled a
    linear Kind
    boolTy) (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    then_expr)
             [ AltCon -> [Id] -> CoreExpr -> CoreAlt
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt DataCon
    falseDataCon) [] CoreExpr
    else_expr,       -- Increasing order of tag!
               AltCon -> [Id] -> CoreExpr -> CoreAlt
    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 -> Kind -> CoreExpr
    castBottomExpr CoreExpr
    e Kind
    res_ty
      | Kind
    e_ty Kind -> Kind -> Bool
    `eqType` Kind
    res_ty = CoreExpr
    e
      | Bool
    otherwise            = CoreExpr -> Id -> Kind -> [CoreAlt] -> CoreExpr
    forall b. Expr b -> b -> Kind -> [Alt b] -> Expr b
    Case CoreExpr
    e (Kind -> Kind -> Id
    mkWildValBinder Kind
    OneTy Kind
    e_ty) Kind
    res_ty []
      where
        e_ty :: Kind
    e_ty = HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    e

    mkLitRubbish :: Type -> Maybe CoreExpr
    -- Make a rubbish-literal CoreExpr of the given type.
    -- Fail (returning Nothing) if
    --    * the RuntimeRep of the Type is not monomorphic;
    --    * the type is (a ~# b), the type of coercion
    -- See INVARIANT 1 and 2 of item (2) in Note [Rubbish literals]
    -- in GHC.Types.Literal
    mkLitRubbish :: Kind -> Maybe CoreExpr
    mkLitRubbish Kind
    ty
      | Bool -> Bool
    not (Kind -> Bool
    noFreeVarsOfType Kind
    rep)
      = Maybe CoreExpr
    forall a. Maybe a
    Nothing   -- Satisfy INVARIANT 1
      | Kind -> Bool
    isCoVarType Kind
    ty
      = Maybe CoreExpr
    forall a. Maybe a
    Nothing   -- Satisfy INVARIANT 2
      | Bool
    otherwise
      = CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (TypeOrConstraint -> Kind -> Literal
    LitRubbish TypeOrConstraint
    torc Kind
    rep) CoreExpr -> [Kind] -> CoreExpr
    forall b. Expr b -> [Kind] -> Expr b
    `mkTyApps` [Kind
    ty])
      where
        Just (TypeOrConstraint
    torc, Kind
    rep) = Kind -> Maybe (TypeOrConstraint, Kind)
    sORTKind_maybe (HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    typeKind Kind
    ty)

    {-
    ************************************************************************
    *                                                                      *
    \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  [Platform -> Integer -> CoreExpr
    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  [Literal -> CoreExpr
    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  [Platform -> Integer -> CoreExpr
    forall b. Platform -> Integer -> Expr b
    mkIntLit Platform
    platform (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i)]

    -- | Create a 'CoreExpr' which will evaluate to 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 [Platform -> Integer -> CoreExpr
    forall b. Platform -> Integer -> Expr b
    mkWordLit Platform
    platform Integer
    w]

    -- | Create a 'CoreExpr' which will evaluate to the given @Integer@
    mkIntegerExpr  :: Platform -> Integer -> CoreExpr  -- Result :: Integer
    mkIntegerExpr :: Platform -> Integer -> CoreExpr
    mkIntegerExpr Platform
    platform Integer
    i
      | Platform -> Integer -> Bool
    platformInIntRange Platform
    platform Integer
    i = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    integerISDataCon [Platform -> Integer -> CoreExpr
    forall b. Platform -> Integer -> Expr b
    mkIntLit Platform
    platform Integer
    i]
      | Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0                         = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    integerINDataCon [Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitBigNat (Integer -> Integer
    forall a. Num a => a -> a
    negate Integer
    i))]
      | Bool
    otherwise                     = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    integerIPDataCon [Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitBigNat Integer
    i)]

    -- | Create a 'CoreExpr' which will evaluate to the given @Natural@
    mkNaturalExpr  :: Platform -> Integer -> CoreExpr
    mkNaturalExpr :: Platform -> Integer -> CoreExpr
    mkNaturalExpr Platform
    platform Integer
    w
      | Platform -> Integer -> Bool
    platformInWordRange Platform
    platform Integer
    w = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    naturalNSDataCon [Platform -> Integer -> CoreExpr
    forall b. Platform -> Integer -> Expr b
    mkWordLit Platform
    platform Integer
    w]
      | Bool
    otherwise                      = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    naturalNBDataCon [Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitBigNat Integer
    w)]

    -- | 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 [Float -> CoreExpr
    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 [Double -> CoreExpr
    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 [Char -> CoreExpr
    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
    mkStringExpr :: forall (m :: * -> *). MonadThings m => String -> m CoreExpr
    mkStringExpr String
    str = FastString -> m CoreExpr
    forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
    mkStringExprFS (String -> FastString
    mkFastString String
    str)

    -- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@
    mkStringExprFS :: MonadThings m => FastString -> m CoreExpr  -- Result :: String
    mkStringExprFS :: forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
    mkStringExprFS = (Name -> m Id) -> FastString -> m CoreExpr
    forall (m :: * -> *).
    Monad m =>
    (Name -> m Id) -> FastString -> m CoreExpr
    mkStringExprFSLookup Name -> m Id
    forall (m :: * -> *). MonadThings m => Name -> m Id
    lookupId

    mkStringExprFSLookup :: Monad m => (Name -> m Id) -> FastString -> m CoreExpr
    mkStringExprFSLookup :: forall (m :: * -> *).
    Monad m =>
    (Name -> m Id) -> FastString -> m CoreExpr
    mkStringExprFSLookup Name -> m Id
    lookupM FastString
    str = do
      mk <- (Name -> m Id) -> m MkStringIds
    forall (m :: * -> *).
    Applicative m =>
    (Name -> m Id) -> m MkStringIds
    getMkStringIds Name -> m Id
    lookupM
      pure (mkStringExprFSWith mk str)

    getMkStringIds :: Applicative m => (Name -> m Id) -> m MkStringIds
    getMkStringIds :: forall (m :: * -> *).
    Applicative m =>
    (Name -> m Id) -> m MkStringIds
    getMkStringIds Name -> m Id
    lookupM = Id -> Id -> MkStringIds
    MkStringIds (Id -> Id -> MkStringIds) -> m Id -> m (Id -> MkStringIds)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> m Id
    lookupM Name
    unpackCStringName m (Id -> MkStringIds) -> m Id -> m MkStringIds
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Name -> m Id
    lookupM Name
    unpackCStringUtf8Name

    data MkStringIds = MkStringIds
      { MkStringIds -> Id
    unpackCStringId     :: !Id
      , MkStringIds -> Id
    unpackCStringUtf8Id :: !Id
      }

    mkStringExprFSWith :: MkStringIds -> FastString -> CoreExpr
    mkStringExprFSWith :: MkStringIds -> FastString -> CoreExpr
    mkStringExprFSWith MkStringIds
    ids FastString
    str
      | FastString -> Bool
    nullFS FastString
    str
      = Kind -> CoreExpr
    mkNilExpr Kind
    charTy

      | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    safeChar String
    chars
      = let !unpack_id :: Id
    unpack_id = MkStringIds -> Id
    unpackCStringId MkStringIds
    ids
        in CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    unpack_id) CoreExpr
    lit

      | Bool
    otherwise
      = let !unpack_utf8_id :: Id
    unpack_utf8_id = MkStringIds -> Id
    unpackCStringUtf8Id MkStringIds
    ids
        in CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> CoreExpr
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    1 Bool -> Bool -> Bool
    && Char -> Int
    ord Char
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0x7F
        lit :: CoreExpr
    lit = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (ByteString -> Literal
    LitString (FastString -> ByteString
    bytesFS FastString
    str))

    {-
    ************************************************************************
    *                                                                      *
         Creating tuples and their types for Core expressions
    *                                                                      *
    ************************************************************************
    -}

    {- 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)
        mkCoreTupSolo [e1] = Solo e1
      We use a suffix "Solo" 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.

    'mkCoreBoxedTuple` and `mkBigCoreVarTupSolo` build tuples without flattening.
    -}

    -- | 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]
    -- Arguments must have kind Type
    mkCoreBoxedTuple :: HasDebugCallStack => [CoreExpr] -> CoreExpr
    mkCoreBoxedTuple :: HasDebugCallStack => [CoreExpr] -> CoreExpr
    mkCoreBoxedTuple [CoreExpr]
    cs
      = Bool
    -> SDoc
    -> (DataCon -> [CoreExpr] -> CoreExpr)
    -> DataCon
    -> [CoreExpr]
    -> CoreExpr
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr ((CoreExpr -> Bool) -> [CoreExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Kind -> Bool
    tcIsLiftedTypeKind (Kind -> Bool) -> (CoreExpr -> Kind) -> CoreExpr -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    typeKind (Kind -> Kind) -> (CoreExpr -> Kind) -> CoreExpr -> Kind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType) [CoreExpr]
    cs) ([CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    cs)
        DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Boxed ([CoreExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CoreExpr]
    cs))
                      ((CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type (Kind -> CoreExpr) -> (CoreExpr -> Kind) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType) [CoreExpr]
    cs [CoreExpr] -> [CoreExpr] -> [CoreExpr]
    forall a. [a] -> [a] -> [a]
    ++ [CoreExpr]
    cs)

    -- | Build a small unboxed tuple holding the specified expressions.
    -- Do not include the RuntimeRep specifiers; this function calculates them
    -- for you.
    -- Does /not/ flatten one-tuples; see Note [Flattening one-tuples]
    mkCoreUnboxedTuple :: [CoreExpr] -> CoreExpr
    mkCoreUnboxedTuple :: [CoreExpr] -> CoreExpr
    mkCoreUnboxedTuple [CoreExpr]
    exps
      = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Unboxed ([Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    tys))
                      ((Kind -> CoreExpr) -> [Kind] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type (Kind -> CoreExpr) -> (Kind -> Kind) -> Kind -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    getRuntimeRep) [Kind]
    tys [CoreExpr] -> [CoreExpr] -> [CoreExpr]
    forall a. [a] -> [a] -> [a]
    ++ (Kind -> CoreExpr) -> [Kind] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type [Kind]
    tys [CoreExpr] -> [CoreExpr] -> [CoreExpr]
    forall a. [a] -> [a] -> [a]
    ++ [CoreExpr]
    exps)
      where
        tys :: [Kind]
    tys = (CoreExpr -> Kind) -> [CoreExpr] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType [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
    HasDebugCallStack => [CoreExpr] -> CoreExpr
    mkCoreBoxedTuple   [CoreExpr]
    exps
    mkCoreTupBoxity Boxity
    Unboxed [CoreExpr]
    exps = [CoreExpr] -> CoreExpr
    mkCoreUnboxedTuple [CoreExpr]
    exps

    -- | 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] -> Kind
    mkCoreVarTupTy [Id]
    ids = [Kind] -> Kind
    mkBoxedTupleTy ((Id -> Kind) -> [Id] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Kind
    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
    HasDebugCallStack => [CoreExpr] -> CoreExpr
    mkCoreBoxedTuple [CoreExpr]
    cs   -- non-1-tuples are uniform

    -- | Build an unboxed sum.
    --
    -- Alternative number ("alt") starts from 1.
    mkCoreUnboxedSum :: Int -> Int -> [Type] -> CoreExpr -> CoreExpr
    mkCoreUnboxedSum :: Int -> Int -> [Kind] -> CoreExpr -> CoreExpr
    mkCoreUnboxedSum Int
    arity Int
    alt [Kind]
    tys CoreExpr
    exp
      = Bool -> CoreExpr -> CoreExpr
    forall a. HasCallStack => Bool -> a -> a
    assert ([Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    tys Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    arity) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        Bool -> CoreExpr -> CoreExpr
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    alt Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    arity) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps (Int -> Int -> DataCon
    sumDataCon Int
    alt Int
    arity)
                      ((Kind -> CoreExpr) -> [Kind] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type (Kind -> CoreExpr) -> (Kind -> Kind) -> Kind -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    getRuntimeRep) [Kind]
    tys
                       [CoreExpr] -> [CoreExpr] -> [CoreExpr]
    forall a. [a] -> [a] -> [a]
    ++ (Kind -> CoreExpr) -> [Kind] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type [Kind]
    tys
                       [CoreExpr] -> [CoreExpr] -> [CoreExpr]
    forall a. [a] -> [a] -> [a]
    ++ [CoreExpr
    exp])

    {- Note [Big tuples]
    ~~~~~~~~~~~~~~~~~~~~
    "Big" tuples (`mkBigCoreTup` and friends) are more general than "small"
    ones (`mkCoreTup` and friends) in two ways.

    1. GHCs built-in tuples can only go up to 'mAX_TUPLE_SIZE' in arity, but
       we might conceivably want to build such a massive tuple as part of the
       output of a desugaring stage (notably that for list comprehensions).

       `mkBigCoreTup` encodes such big tuples by creating and pattern
       matching on /nested/ small tuples that are directly expressible by
       GHC.

       Nesting policy: it's better to have a 2-tuple of 10-tuples (3 objects)
       than a 10-tuple of 2-tuples (11 objects), so we want the leaves of any
       construction to be big.

    2. When desugaring arrows we gather up a tuple of free variables, which
       may include dictionaries (of kind Constraint) and unboxed values.

       These can't live in a tuple. `mkBigCoreTup` encodes such tuples by
       boxing up the offending arguments: see Note [Boxing constructors]
       in GHC.Builtin.Types.

    If you just use the 'mkBigCoreTup', 'mkBigCoreVarTupTy', 'mkBigTupleSelector'
    and 'mkBigTupleCase' functions to do all your work with tuples you should be
    fine, and not have to worry about the arity limitation, or kind limitation at
    all.

    The "big" tuple operations flatten 1-tuples just like "small" tuples.
    But see Note [Don't flatten tuples from HsSyn]
    -}

    mkBigCoreVarTupSolo :: [Id] -> CoreExpr
    -- Same as mkBigCoreVarTup, but:
    --   - one-tuples are not flattened
    --     see Note [Flattening one-tuples]
    --   - arguments should have kind Type
    mkBigCoreVarTupSolo :: [Id] -> CoreExpr
    mkBigCoreVarTupSolo [Id
    id] = [CoreExpr] -> CoreExpr
    HasDebugCallStack => [CoreExpr] -> CoreExpr
    mkCoreBoxedTuple [Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    id]
    mkBigCoreVarTupSolo [Id]
    ids  = ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr
    forall a. ([a] -> a) -> [a] -> a
    mkChunkified [CoreExpr] -> CoreExpr
    mkCoreTup ((Id -> CoreExpr) -> [Id] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> CoreExpr
    forall b. Id -> Expr b
    Var [Id]
    ids)

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

    -- | Build a "big" tuple holding the specified expressions
    -- One-tuples are flattened; see Note [Flattening one-tuples]
    -- Arguments don't have to have kind Type; ones that do not are boxed
    -- This function crashes (in wrapBox) if given a non-Type
    -- argument that it doesn't know how to box.
    mkBigCoreTup :: [CoreExpr] -> CoreExpr
    mkBigCoreTup :: [CoreExpr] -> CoreExpr
    mkBigCoreTup [CoreExpr]
    exprs = ([CoreExpr] -> CoreExpr) -> [CoreExpr] -> CoreExpr
    forall a. ([a] -> a) -> [a] -> a
    mkChunkified [CoreExpr] -> CoreExpr
    mkCoreTup ((CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreExpr -> CoreExpr
    wrapBox [CoreExpr]
    exprs)

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

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

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

    --------------------------------------------------------------
    wrapBox :: CoreExpr -> CoreExpr
    -- ^ If (e :: ty) and (ty :: Type), wrapBox is a no-op
    -- But if (ty :: ki), and ki is not Type, wrapBox returns (K @ty e)
    --     which has kind Type
    -- where K is the boxing data constructor for ki
    -- See Note [Boxing constructors] in GHC.Builtin.Types
    -- Panics if there /is/ no boxing data con
    wrapBox :: CoreExpr -> CoreExpr
    wrapBox CoreExpr
    e
      = case Kind -> BoxingInfo Id
    forall b. Kind -> BoxingInfo b
    boxingDataCon Kind
    e_ty of
          BoxingInfo Id
    BI_NoBoxNeeded                       -> CoreExpr
    e
          BI_Box { bi_inst_con :: forall b. BoxingInfo b -> Expr b
    bi_inst_con = CoreExpr
    boxing_expr } -> CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    boxing_expr CoreExpr
    e
          BoxingInfo Id
    BI_NoBoxAvailable -> String -> SDoc -> CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "wrapBox" (CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    e))
                               -- We should do better than panicing: #22336
      where
        e_ty :: Kind
    e_ty = HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    e

    boxTy :: HasDebugCallStack => Type -> Type
    -- ^ `boxTy ty` is the boxed version of `ty`. That is,
    -- if `e :: ty`, then `wrapBox e :: boxTy ty`.
    -- Note that if `ty :: Type`, `boxTy ty` just returns `ty`.
    -- Panics if it is not possible to box `ty`, like `wrapBox` (#22336)
    -- See Note [Boxing constructors] in GHC.Builtin.Types
    boxTy :: HasDebugCallStack => Kind -> Kind
    boxTy Kind
    ty
      = case Kind -> BoxingInfo Any
    forall b. Kind -> BoxingInfo b
    boxingDataCon Kind
    ty of
          BoxingInfo Any
    BI_NoBoxNeeded -> Kind
    ty
          BI_Box { bi_boxed_type :: forall b. BoxingInfo b -> Kind
    bi_boxed_type = Kind
    box_ty } -> Kind
    box_ty
          BoxingInfo Any
    BI_NoBoxAvailable -> String -> SDoc -> Kind
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "boxTy" (Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    ty)
                               -- We should do better than panicing: #22336

    unwrapBox :: UniqSupply -> Id -> CoreExpr
                     -> (UniqSupply, Id, CoreExpr)
    -- If v's type required boxing (i.e it is unlifted or a constraint)
    -- then (unwrapBox us v body) returns
    --          (case box_v of MkDict v -> body)
    --          together with box_v
    --      where box_v is a fresh variable
    -- Otherwise unwrapBox is a no-op
    -- Panics if no box is available (#22336)
    unwrapBox :: UniqSupply -> Id -> CoreExpr -> (UniqSupply, Id, CoreExpr)
    unwrapBox UniqSupply
    us Id
    var CoreExpr
    body
      = case Kind -> BoxingInfo Any
    forall b. Kind -> BoxingInfo b
    boxingDataCon Kind
    var_ty of
          BoxingInfo Any
    BI_NoBoxNeeded    -> (UniqSupply
    us, Id
    var, CoreExpr
    body)
          BoxingInfo Any
    BI_NoBoxAvailable -> String -> SDoc -> (UniqSupply, Id, CoreExpr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "unwrapBox" (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    var SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    var_ty)
                               -- We should do better than panicing: #22336
          BI_Box { bi_data_con :: forall b. BoxingInfo b -> DataCon
    bi_data_con = DataCon
    box_con, bi_boxed_type :: forall b. BoxingInfo b -> Kind
    bi_boxed_type = Kind
    box_ty }
             -> (UniqSupply
    us', Id
    var', CoreExpr
    body')
             where
               var' :: Id
    var'  = FastString -> Unique -> Kind -> Kind -> Id
    mkSysLocal (String -> FastString
    fsLit String
    "uc") Unique
    uniq Kind
    ManyTy Kind
    box_ty
               body' :: CoreExpr
    body' = CoreExpr -> Id -> Kind -> [CoreAlt] -> CoreExpr
    forall b. Expr b -> b -> Kind -> [Alt b] -> Expr b
    Case (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    var') Id
    var' (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    body)
                            [AltCon -> [Id] -> CoreExpr -> CoreAlt
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt DataCon
    box_con) [Id
    var] CoreExpr
    body]
      where
        var_ty :: Kind
    var_ty      = Id -> Kind
    idType Id
    var
        (Unique
    uniq, UniqSupply
    us') = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply UniqSupply
    us

    -- | Lifts a \"small\" constructor into a \"big\" constructor by recursive decomposition
    mkChunkified :: ([a] -> a)      -- ^ \"Small\" constructor function, of maximum input arity 'mAX_TUPLE_SIZE'
                 -> [a]             -- ^ Possible \"big\" list of things to construct from
                 -> a               -- ^ Constructed thing made possible by recursive decomposition
    mkChunkified :: forall a. ([a] -> a) -> [a] -> a
    mkChunkified [a] -> a
    small_tuple [a]
    as = [[a]] -> a
    mk_big_tuple ([a] -> [[a]]
    forall a. [a] -> [[a]]
    chunkify [a]
    as)
      where
            -- Each sub-list is short enough to fit in a tuple
        mk_big_tuple :: [[a]] -> a
    mk_big_tuple [[a]
    as] = [a] -> a
    small_tuple [a]
    as
        mk_big_tuple [[a]]
    as_s = [[a]] -> a
    mk_big_tuple ([a] -> [[a]]
    forall a. [a] -> [[a]]
    chunkify (([a] -> a) -> [[a]] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> a
    small_tuple [[a]]
    as_s))

    chunkify :: [a] -> [[a]]
    -- ^ Split a list into lists that are small enough to have a corresponding
    -- tuple arity. The sub-lists of the result all have length <= 'mAX_TUPLE_SIZE'
    -- But there may be more than 'mAX_TUPLE_SIZE' sub-lists
    chunkify :: forall a. [a] -> [[a]]
    chunkify [a]
    xs
      | Int
    n_xs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    mAX_TUPLE_SIZE = [[a]
    xs]
      | Bool
    otherwise              = [a] -> [[a]]
    forall a. [a] -> [[a]]
    split [a]
    xs
      where
        n_xs :: Int
    n_xs     = [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs
        split :: [a] -> [[a]]
    split [] = []
        split [a]
    xs = let ([a]
    as, [a]
    bs) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    mAX_TUPLE_SIZE [a]
    xs
                   in [a]
    as [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a] -> [[a]]
    split [a]
    bs

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

    -- | Builds a selector which scrutinises 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 `mkBigTupleSelector` must consume its scrutinee 'Many'
    -- times. And all the argument variables must have multiplicity 'Many'.
    mkBigTupleSelector, mkBigTupleSelectorSolo
        :: [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

    -- mkBigTupleSelector [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
    mkBigTupleSelector :: [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkBigTupleSelector [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut
      = [[Id]] -> Id -> CoreExpr
    mk_tup_sel ([Id] -> [[Id]]
    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 (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                                    [[Id]] -> Id -> CoreExpr
    mk_tup_sel ([Id] -> [[Id]]
    forall a. [a] -> [[a]]
    chunkify [Id]
    tpl_vs) Id
    tpl_v
            where
              tpl_tys :: [Kind]
    tpl_tys = [[Kind] -> Kind
    mkBoxedTupleTy ((Id -> Kind) -> [Id] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Kind
    idType [Id]
    gp) | [Id]
    gp <- [[Id]]
    vars_s]
              tpl_vs :: [Id]
    tpl_vs  = [Kind] -> [Id]
    mkTemplateLocals [Kind]
    tpl_tys
              [(Id
    tpl_v, [Id]
    group)] = [(Id
    tpl,[Id]
    gp) | (Id
    tpl,[Id]
    gp) <- String -> [Id] -> [[Id]] -> [(Id, [Id])]
    forall a b. HasDebugCallStack => String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "mkBigTupleSelector" [Id]
    tpl_vs [[Id]]
    vars_s,
                                             Id
    the_var Id -> [Id] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Id]
    gp ]
    -- ^ 'mkBigTupleSelectorSolo' is like 'mkBigTupleSelector'
    -- but one-tuples are NOT flattened (see Note [Flattening one-tuples])
    mkBigTupleSelectorSolo :: [Id] -> Id -> Id -> CoreExpr -> CoreExpr
    mkBigTupleSelectorSolo [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
    mkBigTupleSelector [Id]
    vars Id
    the_var Id
    scrut_var CoreExpr
    scrut

    -- | `mkSmallTupleSelector` is like 'mkBigTupleSelector', but for tuples that
    -- are guaranteed never to be "big".  Also does not unwrap boxed types.
    --
    -- > 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
      = Bool -> CoreExpr -> CoreExpr
    forall a. HasCallStack => Bool -> a -> a
    assert (Id
    var Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    should_be_the_same_var) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        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
      = Bool -> CoreExpr -> CoreExpr
    forall a. HasCallStack => Bool -> a -> a
    assert ([Id] -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull [Id]
    vars) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        CoreExpr -> Id -> Kind -> [CoreAlt] -> CoreExpr
    forall b. Expr b -> b -> Kind -> [Alt b] -> Expr b
    Case CoreExpr
    scrut Id
    scrut_var (Id -> Kind
    idType Id
    the_var)
             [AltCon -> [Id] -> CoreExpr -> CoreAlt
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Boxed ([Id] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Id]
    vars))) [Id]
    vars (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    the_var)]

    -- | A generalization of 'mkBigTupleSelector', 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.
    mkBigTupleCase :: MonadUnique m    --   For inventing names of intermediate variables
                   => [Id]             -- ^ The tuple identifiers to pattern match on;
                                       --   Bring these into scope in the body
                   -> CoreExpr         -- ^ Body of the case
                   -> CoreExpr         -- ^ Scrutinee
                   -> m CoreExpr
    -- ToDo: eliminate cases where none of the variables are needed.
    --
    --         mkBigTupleCase 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 }}}
    mkBigTupleCase :: forall (m :: * -> *).
    MonadUnique m =>
    [Id] -> CoreExpr -> CoreExpr -> m CoreExpr
    mkBigTupleCase [Id]
    vars CoreExpr
    body CoreExpr
    scrut
      = do us <- m UniqSupply
    forall (m :: * -> *). MonadUnique m => m UniqSupply
    getUniqueSupplyM
           let (wrapped_us, wrapped_vars, wrapped_body) = foldr unwrap (us,[],body) vars
           return $ mk_tuple_case wrapped_us (chunkify wrapped_vars) wrapped_body
      where
        scrut_ty :: Kind
    scrut_ty = HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    scrut

        unwrap :: Id -> (UniqSupply, [Id], CoreExpr) -> (UniqSupply, [Id], CoreExpr)
    unwrap Id
    var (UniqSupply
    us,[Id]
    vars,CoreExpr
    body)
          = (UniqSupply
    us', Id
    var'Id -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :[Id]
    vars, CoreExpr
    body')
          where
            (UniqSupply
    us', Id
    var', CoreExpr
    body') = UniqSupply -> Id -> CoreExpr -> (UniqSupply, Id, CoreExpr)
    unwrapBox UniqSupply
    us Id
    var CoreExpr
    body

        mk_tuple_case :: UniqSupply -> [[Id]] -> CoreExpr -> CoreExpr
        -- mk_tuple_case [[a1..an], [b1..bm], ...] body
        --    case scrut of (p,q, ...) ->
        --    case p of (a1,..an) ->
        --    case q of (b1,..bm) ->
        --    ... -> body
        -- This is the case where don't need any nesting
        mk_tuple_case :: UniqSupply -> [[Id]] -> CoreExpr -> CoreExpr
    mk_tuple_case UniqSupply
    us [[Id]
    vars] CoreExpr
    body
          = [Id] -> CoreExpr -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleCase [Id]
    vars CoreExpr
    body Id
    scrut_var CoreExpr
    scrut
          where
            scrut_var :: Id
    scrut_var = case CoreExpr
    scrut of
                           Var Id
    v -> Id
    v
                           CoreExpr
    _ -> (UniqSupply, Id) -> Id
    forall a b. (a, b) -> b
    snd (UniqSupply -> Kind -> (UniqSupply, Id)
    new_var UniqSupply
    us Kind
    scrut_ty)

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

        one_tuple_case :: [Id]
    -> (UniqSupply, [Id], CoreExpr) -> (UniqSupply, [Id], CoreExpr)
    one_tuple_case [Id]
    chunk_vars (UniqSupply
    us, [Id]
    vs, CoreExpr
    body)
          = (UniqSupply
    us', Id
    scrut_varId -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :[Id]
    vs, CoreExpr
    body')
          where
            tup_ty :: Kind
    tup_ty           = [Kind] -> Kind
    mkBoxedTupleTy ((Id -> Kind) -> [Id] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Kind
    idType [Id]
    chunk_vars)
            (UniqSupply
    us', Id
    scrut_var) = UniqSupply -> Kind -> (UniqSupply, Id)
    new_var UniqSupply
    us Kind
    tup_ty
            body' :: CoreExpr
    body' = [Id] -> CoreExpr -> Id -> CoreExpr -> CoreExpr
    mkSmallTupleCase [Id]
    chunk_vars CoreExpr
    body Id
    scrut_var (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    scrut_var)

        new_var :: UniqSupply -> Type -> (UniqSupply, Id)
        new_var :: UniqSupply -> Kind -> (UniqSupply, Id)
    new_var UniqSupply
    us Kind
    ty = (UniqSupply
    us', Id
    id)
           where
             (Unique
    uniq, UniqSupply
    us') = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply UniqSupply
    us
             id :: Id
    id = FastString -> Unique -> Kind -> Kind -> Id
    mkSysLocal (String -> FastString
    fsLit String
    "ds") Unique
    uniq Kind
    ManyTy Kind
    ty

    -- | As 'mkBigTupleCase', 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
      = HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr
    Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    var CoreExpr
    scrut CoreExpr
    body
    mkSmallTupleCase [Id]
    vars CoreExpr
    body Id
    scrut_var CoreExpr
    scrut
      = CoreExpr -> Id -> Kind -> [CoreAlt] -> CoreExpr
    forall b. Expr b -> b -> Kind -> [Alt b] -> Expr b
    Case CoreExpr
    scrut Id
    scrut_var (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    body)
             [AltCon -> [Id] -> CoreExpr -> CoreAlt
    forall b. AltCon -> [b] -> Expr b -> Alt b
    Alt (DataCon -> AltCon
    DataAlt (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Boxed ([Id] -> Int
    forall a. [a] -> Int
    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
    forall doc. IsLine doc => String -> doc
    text String
    "LET" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreBind -> 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
    forall doc. IsLine doc => String -> doc
    text String
    "CASE" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "of" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    b)
                                    Int
    2 (AltCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltCon
    c SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    bs)

    wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
    wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
    wrapFloat (FloatLet CoreBind
    defns)       CoreExpr
    body = CoreBind -> CoreExpr -> CoreExpr
    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 = (FloatBind -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [FloatBind] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    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) = ((Id, CoreExpr) -> Id) -> [(Id, CoreExpr)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id, CoreExpr) -> Id
    forall a b. (a, b) -> a
    fst [(Id, CoreExpr)]
    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
    bId -> [Id] -> [Id]
    forall 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 :: Kind -> CoreExpr
    mkNilExpr Kind
    ty = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    nilDataCon [Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type Kind
    ty]

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

    -- | Make a list containing the given expressions, where the list has the given type
    mkListExpr :: Type -> [CoreExpr] -> CoreExpr
    mkListExpr :: Kind -> [CoreExpr] -> CoreExpr
    mkListExpr Kind
    ty [CoreExpr]
    xs = (CoreExpr -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [CoreExpr] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Kind -> CoreExpr -> CoreExpr -> CoreExpr
    mkConsExpr Kind
    ty) (Kind -> CoreExpr
    mkNilExpr Kind
    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 =>
    Kind -> Kind -> CoreExpr -> CoreExpr -> CoreExpr -> m CoreExpr
    mkFoldrExpr Kind
    elt_ty Kind
    result_ty CoreExpr
    c CoreExpr
    n CoreExpr
    list = do
        foldr_id <- Name -> m Id
    forall (m :: * -> *). MonadThings m => Name -> m Id
    lookupId Name
    foldrName
        return (Var foldr_id `App` Type elt_ty
               `App` Type result_ty
               `App` c
               `App` n
               `App` 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) =>
    Kind -> ((Id, Kind) -> (Id, Kind) -> m CoreExpr) -> m CoreExpr
    mkBuildExpr Kind
    elt_ty (Id, Kind) -> (Id, Kind) -> m CoreExpr
    mk_build_inside = do
        n_tyvar <- Id -> m Id
    forall {m :: * -> *}. MonadUnique m => Id -> m Id
    newTyVar Id
    alphaTyVar
        let n_ty = Id -> Kind
    mkTyVarTy Id
    n_tyvar
            c_ty = [Kind] -> Kind -> Kind
    mkVisFunTysMany [Kind
    elt_ty, Kind
    n_ty] Kind
    n_ty
        [c, n] <- sequence [mkSysLocalM (fsLit "c") ManyTy c_ty, mkSysLocalM (fsLit "n") ManyTy n_ty]

        build_inside <- mk_build_inside (c, c_ty) (n, n_ty)

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

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

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

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

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

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

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

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

    errorIds :: [Id]
    errorIds :: [Id]
    errorIds
      = [ 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
    iMPOSSIBLE_ERROR_ID, Id
    iMPOSSIBLE_CONSTRAINT_ERROR_ID,
          Id
    aBSENT_ERROR_ID,  Id
    aBSENT_CONSTRAINT_ERROR_ID,
          Id
    aBSENT_SUM_FIELD_ERROR_ID,
          Id
    tYPE_ERROR_ID   -- Used with Opt_DeferTypeErrors, see #10284
          ]

    recSelErrorName, recConErrorName, patErrorName :: Name
    nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name
    typeErrorName :: Name
    absentSumFieldErrorName :: Name

    recSelErrorName :: Name
    recSelErrorName     = String -> Unique -> Id -> Name
    err_nm String
    "recSelError"     Unique
    recSelErrorIdKey     Id
    rEC_SEL_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
    gHC_INTERNAL_CONTROL_EXCEPTION_BASE (String -> FastString
    fsLit String
    str) Unique
    uniq Id
    id

    rEC_SEL_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_SUM_FIELD_ERROR_ID :: Id
    rEC_SEL_ERROR_ID :: Id
    rEC_SEL_ERROR_ID                = TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    TypeLike Name
    recSelErrorName
    rEC_CON_ERROR_ID :: Id
    rEC_CON_ERROR_ID                = TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    TypeLike Name
    recConErrorName
    pAT_ERROR_ID :: Id
    pAT_ERROR_ID                    = TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    TypeLike Name
    patErrorName
    nO_METHOD_BINDING_ERROR_ID :: Id
    nO_METHOD_BINDING_ERROR_ID      = TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    TypeLike Name
    noMethodBindingErrorName
    nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
    nON_EXHAUSTIVE_GUARDS_ERROR_ID  = TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    TypeLike Name
    nonExhaustiveGuardsErrorName
    tYPE_ERROR_ID :: Id
    tYPE_ERROR_ID                   = TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    TypeLike 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.
    -- For instance, consider the case of the program:
    --
    --     f :: (# Int | Float# #) -> Int
    --     f = ...
    --
    --     x = f (# | 2.0## #)
    --
    -- Unarise will represent f's unboxed sum argument as a tuple (# Int#, Int,
    -- Float# #), where Int# is a tag. Consequently, `x` will be rewritten to:
    --
    --     x = f (# 2#, ???, 2.0## #)
    --
    -- We must come up with some rubbish literal to use in place of `???`. In the
    -- case of unboxed integer types this is easy: we can simply use 0 for
    -- Int#/Word# and 0.0 Float#/Double#.
    --
    -- However, coming up with a rubbish pointer value is more delicate as the
    -- value must satisfy the following requirements:
    --
    --    1. it needs to be a valid closure pointer for the GC (not a NULL pointer)
    --
    --    2. it can't take arguments because it's used in unarise and applying an
    --       argument would require allocating a thunk, which is both difficult to
    --       do and costly.
    --
    --    3. it shouldn't be CAFfy since this would make otherwise non-CAFfy
    --       bindings CAFfy, incurring a cost in GC performance. Given that unboxed
    --       sums are intended to be used in performance-critical code, this is to
    --       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.
    --
    --    4. it can't be defined in `base` package.  Afterall, not all code which
    --       uses unboxed sums uses depends upon `base`.  Specifically, this became
    --       an issue when we wanted to use unboxed sums in boot libraries used by
    --       `base`, see #17791.
    --
    -- To fill this role we define `ghc-prim:GHC.Prim.Panic.absentSumFieldError`
    -- with the type:
    --
    --    absentSumFieldError :: forall a. a
    --
    -- Note that this type is something of a lie since Unarise may use it at an
    -- unlifted type. However, this lie is benign as absent sum fields are examined
    -- only by the GC, which does not care about levity..
    --
    -- When entered, this closure calls `stg_panic#`, which immediately halts
    -- execution and cannot be caught. This is in contrast to most other runtime
    -- errors, which are thrown as proper Haskell exceptions. This design is
    -- intentional since entering an absent sum field is an indication that
    -- something has gone horribly wrong, very likely due to a compiler bug.
    --

    -- Note [Wired-in exceptions are not CAFfy]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- GHC has logic wiring-in a small number of exceptions, which may be thrown in
    -- generated code. Specifically, these are implemented via closures (defined
    -- in `GHC.Prim.Exception` in `ghc-prim`) which, when entered, raise the desired
    -- exception. For instance, in the case of OverflowError we have
    --
    --     raiseOverflow :: forall a. a
    --     raiseOverflow = runRW# (\s ->
    --         case raiseOverflow# s of
    --           (# _, _ #) -> let x = x in x)
    --
    -- where `raiseOverflow#` is defined in the rts/Exception.cmm.
    --
    -- Note that `raiseOverflow` and friends, being top-level thunks, are CAFs.
    -- Normally, this would be reflected in their IdInfo; however, as these
    -- functions are widely used and CAFfyness is transitive, we very much want to
    -- avoid declaring them as CAFfy. This is especially true in especially in
    -- performance-critical code like that using unboxed sums and
    -- absentSumFieldError.
    --
    -- Consequently, `mkExceptionId` instead declares the exceptions to be
    -- non-CAFfy and rather ensure in the RTS (in `initBuiltinGcRoots` in
    -- rts/RtsStartup.c) that these closures remain reachable by creating a
    -- StablePtr to each. Note that we are using the StablePtr mechanism not
    -- because we need a StablePtr# object, but rather because the stable pointer
    -- table is a source of GC roots.
    --
    -- 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

    aBSENT_SUM_FIELD_ERROR_ID :: Id
    aBSENT_SUM_FIELD_ERROR_ID = Name -> Id
    mkExceptionId Name
    absentSumFieldErrorName

    -- | 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 -> Kind -> IdInfo -> Id
    mkVanillaGlobalWithInfo Name
    name
          ([Id] -> Kind -> Kind
    mkSpecForAllTys [Id
    alphaTyVar] (Id -> Kind
    mkTyVarTy Id
    alphaTyVar)) -- forall a . a
          ([Demand] -> IdInfo
    divergingIdInfo [] IdInfo -> CafInfo -> IdInfo
    `setCafInfo` CafInfo
    NoCafRefs)
             -- See Note [Wired-in exceptions are not CAFfy]

    -- | An 'IdInfo' for an Id, such as 'aBSENT_ERROR_ID', that
    -- throws an (imprecise) exception after being supplied one value arg for every
    -- argument 'Demand' in the list. The demands end up in the demand signature.
    --
    -- 1. Sets the demand signature to unleash the given arg dmds 'botDiv'
    -- 2. Sets the arity info so that it matches the length of arg demands
    -- 3. Sets a bottoming CPR sig with the correct arity
    --
    -- It's important that all 3 agree on the arity, which is what this defn ensures.
    divergingIdInfo :: [Demand] -> IdInfo
    divergingIdInfo :: [Demand] -> IdInfo
    divergingIdInfo [Demand]
    arg_dmds
      = IdInfo
    vanillaIdInfo IdInfo -> Int -> IdInfo
    `setArityInfo` Int
    arity
                      IdInfo -> DmdSig -> IdInfo
    `setDmdSigInfo` [Demand] -> Divergence -> DmdSig
    mkClosedDmdSig [Demand]
    arg_dmds Divergence
    botDiv
                      IdInfo -> CprSig -> IdInfo
    `setCprSigInfo` Int -> Cpr -> CprSig
    mkCprSig Int
    arity Cpr
    botCpr
      where
        arity :: Int
    arity = [Demand] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Demand]
    arg_dmds

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

    ************************************************************************
    *                                                                      *
                         iMPOSSIBLE_ERROR_ID
    *                                                                      *
    ************************************************************************
    -}

    iMPOSSIBLE_ERROR_ID, iMPOSSIBLE_CONSTRAINT_ERROR_ID :: Id
    iMPOSSIBLE_ERROR_ID :: Id
    iMPOSSIBLE_ERROR_ID            = TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    TypeLike       Name
    impossibleErrorName
    iMPOSSIBLE_CONSTRAINT_ERROR_ID :: Id
    iMPOSSIBLE_CONSTRAINT_ERROR_ID = TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    ConstraintLike Name
    impossibleConstraintErrorName

    impossibleErrorName, impossibleConstraintErrorName :: Name
    impossibleErrorName :: Name
    impossibleErrorName           = String -> Unique -> Id -> Name
    err_nm String
    "impossibleError"
                                    Unique
    impossibleErrorIdKey Id
    iMPOSSIBLE_ERROR_ID
    impossibleConstraintErrorName :: Name
    impossibleConstraintErrorName = String -> Unique -> Id -> Name
    err_nm String
    "impossibleConstraintError"
                                    Unique
    impossibleConstraintErrorIdKey Id
    iMPOSSIBLE_CONSTRAINT_ERROR_ID

    mkImpossibleExpr :: Type -> String -> CoreExpr
    mkImpossibleExpr :: Kind -> String -> CoreExpr
    mkImpossibleExpr Kind
    res_ty String
    str
      = Id -> Kind -> String -> CoreExpr
    mkRuntimeErrorApp Id
    err_id Kind
    res_ty String
    str
      where    -- See Note [Type vs Constraint for error ids]
        err_id :: Id
    err_id = case HasDebugCallStack => Kind -> TypeOrConstraint
    Kind -> TypeOrConstraint
    typeTypeOrConstraint Kind
    res_ty of
                   TypeOrConstraint
    TypeLike       -> Id
    iMPOSSIBLE_ERROR_ID
                   TypeOrConstraint
    ConstraintLike -> Id
    iMPOSSIBLE_CONSTRAINT_ERROR_ID

    {- Note [Type vs Constraint for error ids]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We need both
      iMPOSSIBLE_ERROR_ID            :: forall (r::RuntimeRep) (a::TYPE r).       Addr# -> a
      iMPOSSIBLE_CONSTRAINT_ERROR_ID :: forall (r::RuntimeRep) (a::CONSTRAINT r). Addr# -> a

    because we don't have polymorphism over TYPE vs CONSTRAINT.  You
    might wonder if iMPOSSIBLE_CONSTRAINT_ERROR_ID is ever needed in
    practice, but it is: see #22634.  So:

    * In Control.Exception.Base we have
          impossibleError           :: forall (a::Type). Addr# -> a
          impossibleConstraintError :: forall (a::Type). Addr# -> a
      This generates the code for `impossibleError`, but because they are wired in
      the interface file definitions are never looked at (indeed, they don't
      even get serialised).

    * In this module GHC.Core.Make we define /wired-in/ Ids for
          iMPOSSIBLE_ERROR_ID
          iMPOSSIBLE_CONSTRAINT_ERROR_ID
       with the desired above types (i.e. runtime-rep polymorphic, and returning a
       constraint for the latter.

    Much the same plan works for aBSENT_ERROR_ID and aBSENT_CONSTRAINT_ERROR_ID

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

    Note [aBSENT_ERROR_ID]
    ~~~~~~~~~~~~~~~~~~~~~~
    We use aBSENT_ERROR_ID to build absent fillers for lifted types 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 normally goes away.
    See also Note [Absent fillers] in GHC.Core.Opt.WorkWrap.Utils.

    Historical Note
    ---------------
    We used to have exprIsHNF respond True to absentError and *not* mark it as diverging.
    Here's the reason for the former. It doesn't apply anymore because we no longer say
    that `a` is absent (A). Instead it gets (head strict) demand 1A and we won't
    emit the absent error:

    #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 INLINABLE 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.
    -}

    -- We need two absentError Ids:
    --   absentError           :: forall (a :: Type).       Addr# -> a
    --   absentConstraintError :: forall (a :: Constraint). Addr# -> a
    -- We don't have polymorphism over TypeOrConstraint!
    -- mkAbsentErrorApp chooses which one to use, based on the kind
    -- See Note [Type vs Constraint for error ids]

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

    mkAbsentErrorApp :: Kind -> String -> CoreExpr
    mkAbsentErrorApp Kind
    res_ty String
    err_msg
      = CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    err_id) [ Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type Kind
    res_ty, CoreExpr
    err_string ]
      where
        err_id :: Id
    err_id = case HasDebugCallStack => Kind -> TypeOrConstraint
    Kind -> TypeOrConstraint
    typeTypeOrConstraint Kind
    res_ty of
                   TypeOrConstraint
    TypeLike       -> Id
    aBSENT_ERROR_ID
                   TypeOrConstraint
    ConstraintLike -> Id
    aBSENT_CONSTRAINT_ERROR_ID
        err_string :: CoreExpr
    err_string = Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (String -> Literal
    mkLitString String
    err_msg)

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

    absentConstraintErrorName :: Name
    absentConstraintErrorName   -- See Note [Type vs Constraint for error ids]
       = Module -> FastString -> Unique -> Id -> Name
    mkWiredInIdName Module
    gHC_PRIM_PANIC (String -> FastString
    fsLit String
    "absentConstraintError")
          Unique
    absentConstraintErrorIdKey Id
    aBSENT_CONSTRAINT_ERROR_ID

    aBSENT_ERROR_ID, aBSENT_CONSTRAINT_ERROR_ID :: Id

    aBSENT_ERROR_ID :: Id
    aBSENT_ERROR_ID -- See Note [aBSENT_ERROR_ID]
     = Name -> Kind -> Id
    mk_runtime_error_id Name
    absentErrorName Kind
    absent_ty
     where
       -- absentError :: forall (a :: Type). Addr# -> a
       absent_ty :: Kind
    absent_ty = [Id] -> Kind -> Kind
    mkSpecForAllTys [Id
    alphaTyVar] (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                   HasDebugCallStack => Kind -> Kind -> Kind
    Kind -> Kind -> Kind
    mkVisFunTyMany Kind
    addrPrimTy (Id -> Kind
    mkTyVarTy Id
    alphaTyVar)
       -- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for
       -- lifted-type things; see Note [Absent fillers] in GHC.Core.Opt.WorkWrap.Utils

    aBSENT_CONSTRAINT_ERROR_ID :: Id
    aBSENT_CONSTRAINT_ERROR_ID -- See Note [aBSENT_ERROR_ID]
     = Name -> Kind -> Id
    mk_runtime_error_id Name
    absentConstraintErrorName Kind
    absent_ty
       -- See Note [Type vs Constraint for error ids]
     where
       -- absentConstraintError :: forall (a :: Constraint). Addr# -> a
       absent_ty :: Kind
    absent_ty = [Id] -> Kind -> Kind
    mkSpecForAllTys [Id
    alphaConstraintTyVar] (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                   HasDebugCallStack => FunTyFlag -> Kind -> Kind -> Kind -> Kind
    FunTyFlag -> Kind -> Kind -> Kind -> Kind
    mkFunTy FunTyFlag
    visArgConstraintLike Kind
    ManyTy
                           Kind
    addrPrimTy (Id -> Kind
    mkTyVarTy Id
    alphaConstraintTyVar)

    {-
    ************************************************************************
    *                                                                      *
                         mkRuntimeErrorId
    *                                                                      *
    ************************************************************************
    -}

    mkRuntimeErrorId :: TypeOrConstraint -> 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 :: TypeOrConstraint -> Name -> Id
    mkRuntimeErrorId TypeOrConstraint
    torc Name
    name = Name -> Kind -> Id
    mk_runtime_error_id Name
    name (TypeOrConstraint -> Kind
    mkRuntimeErrorTy TypeOrConstraint
    torc)

    mk_runtime_error_id :: Name -> Type -> Id
    mk_runtime_error_id :: Name -> Kind -> Id
    mk_runtime_error_id Name
    name Kind
    ty
     = Name -> Kind -> IdInfo -> Id
    mkVanillaGlobalWithInfo Name
    name Kind
    ty ([Demand] -> IdInfo
    divergingIdInfo [Demand
    evalDmd])
         -- 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.

    mkRuntimeErrorTy :: TypeOrConstraint -> Type
    -- forall (rr :: RuntimeRep) (a :: rr). Addr# -> a
    --   See Note [Error and friends have an "open-tyvar" forall]
    mkRuntimeErrorTy :: TypeOrConstraint -> Kind
    mkRuntimeErrorTy TypeOrConstraint
    torc = [Id] -> Kind -> Kind
    mkSpecForAllTys [Id
    runtimeRep1TyVar, Id
    tyvar] (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                            HasDebugCallStack => Kind -> Kind -> Kind -> Kind
    Kind -> Kind -> Kind -> Kind
    mkFunctionType Kind
    ManyTy Kind
    addrPrimTy (Id -> Kind
    mkTyVarTy Id
    tyvar)
      where
        (Id
    tyvar:[Id]
    _) = [Kind] -> [Id]
    mkTemplateTyVars [Kind
    kind]
        kind :: Kind
    kind = case TypeOrConstraint
    torc of
                  TypeOrConstraint
    TypeLike       -> Kind -> Kind
    mkTYPEapp       Kind
    runtimeRep1Ty
                  TypeOrConstraint
    ConstraintLike -> Kind -> Kind
    mkCONSTRAINTapp Kind
    runtimeRep1Ty