fun_ty  = mkLamTypes val_bndrs body_ty

                        -- This type is a bit ill-formed but it doesn't matter

              rhs = StgRhsClosure noExtFieldSilent currentCCS

              tmp_fun = mkSysLocal (fsLit "pap") uniq ManyTy fun_ty

        ; return (StgLet noExtFieldSilent (StgNonRec tmp_fun rhs) $

                  StgApp tmp_fun []) }

     f_arity    = stgArity f how_bound

     n_val_args = length stg_args  -- StgArgs are all value arguments

     exactly_saturated  = f_arity == n_val_args

 -- Given Core arguments to an unboxed sum datacon, return the 'PrimRep's

     let mk_rhs = MkStgRhs

           { rhs_args = bndrs

           , rhs_expr = body'

           , rhs_is_join = isJoinId bndr

           }

     pure mk_rhs

 bcPrepExpr :: StgExpr -> BcPrepM StgExpr

 -- explicitly match all constructors so we get a warning if we miss any

 bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs)

       id <- newId tick_ty

       rhs' <- bcPrepExpr rhs

       let expr' = StgTick bp rhs'

                                             ReEntrant

                                             []

                                             expr'

                              )

           letExp = StgLet noExtFieldSilent bnd (StgApp id [])

       pure letExp

                                             ReEntrant

                                             [voidArgId]

                                             expr'

                              )

       pure $ StgLet noExtFieldSilent bnd (StgApp id [StgVarArg realWorldPrimId])

 bcPrepExpr (StgTick tick rhs) =

   StgTick tick <$> bcPrepExpr rhs

 bcPrepExpr (StgLet xlet bnds expr) =

 -}

 module GHC.Stg.Syntax (

         StgFArgType(..),

         collectStgFArgTypes,

 import GHC.Core     ( AltCon )

 import GHC.Core.DataCon

 import GHC.Core.TyCon    ( PrimRep(..), PrimOrVoidRep(..), TyCon )

 import GHC.Core.Ppr( {- instances -} )

 import GHC.Types.ForeignCall ( ForeignCall )

 import GHC.Types.Tickish     ( StgTickish )

 import GHC.Types.Var.Set

 import GHC.Types.Literal     ( Literal, literalType )

 import GHC.Utils.Outputable

 import GHC.Utils.Panic.Plain

 import GHC.Builtin.PrimOps ( PrimOp, PrimCall )

 -- Kind is otherwise equal to.

 -- See Note [Kinds in STG]

 newtype StgKind = MkStgKind { getStgKind :: Kind }

 {-

 Note [Kinds in STG]

 ~~~~~~~~~~~~~~~~~~~

 Just as many different values may have a single type, so many different

 types may have a single kind. So kinds are a "coarser approximation" to the

 values being manipulated; and that is what we want in STG.

 (1) It is easier for third party projects to compile to STG. The type system of

     another language might not be compatible with GHC's type system. In such a

     case the kind system is often still compatible because it is so much coarser.

 (2) It allows for more aggressive optimizations. In STG we may do

       f :: Either a b -> Either a c

       f = \x -> case x of r

                   Left _ -> r        <------------- NB

                   Right _ -> error "urk"

     This is not type-safe in Core, but it is kind-safe in STG. So, using

     the coarser notion of kinds in STG allows us to do more aggressive

 Note that the kinds do not always accurately reflect the final runtime

 representation. For example, on the JS backend the kind 'TYPE Int64Rep'

 Note [tagToEnum# in STG]

 ~~~~~~~~~~~~~~~~~~~~~~~~

 STG is untyped, but 'tagToEnum#' needs type information, so we make it a special

 STG operation which stores the type constructor information alongside it.

 'StgTagToEnumOp' which has an extra field to store the type constructor

 information. This desugaring happens when converting Core to STG, which is the

 last moment that we still have access to the type information.

 -}

 data StgOp

     ((op,ty,uq):rest_ops) ->

       let out_id' = mkCastVar uq ty -- out_name `setIdUnique` uq `setIdType` ty

           sub_cast = castArgRename rest_ops (StgVarArg out_id')

 -- Construct a case binder used when casting sums, of a given type and unique.

 mkCastVar :: Unique -> Type -> Id

 mkCast arg_in cast_op out_id out_kind in_rhs =

   let scrut = StgOpApp (StgPrimOp cast_op) [arg_in]

       alt = GenStgAlt { alt_con = DEFAULT, alt_bndrs = [], alt_rhs = in_rhs}

   in (StgCase scrut out_id alt_ty [alt])

 -- | Build a unboxed sum term from arguments of an alternative.

 schemeE d s p (StgCase scrut bndr _ alts)

    = doCase d s p scrut bndr alts

 {-

    Ticked Expressions

    ------------------

 cgForeignCall (CCall (CCallSpec target cconv safety)) arg_tys stg_args res_kind

   = do  { cmm_args <- getFCallArgs stg_args arg_tys

         -- ; traceM $ show cmm_args

         ; let ((call_args, arg_hints), cmm_target)

                 = case target of

                     StaticTarget _ _ ForeignValue ->

 import GHC.Stg.Syntax

 import GHC.Cmm

 import GHC.Unit         ( rtsUnit )

 import GHC.Core.TyCon ( isEnumerationTyCon )

 import GHC.Cmm.CLabel

 import GHC.Cmm.Info     ( closureInfoPtr )

 cmmPrimOpApp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> FCode ReturnKind

 cmmPrimOpApp cfg primop cmm_args =

   let PrimopCmmEmit _inline f = emitPrimOp cfg primop cmm_args

 externalPrimop :: PrimOp -> [CmmExpr] -> PrimopCmmEmit

 externalPrimop primop args = outOfLinePrimop (callExternalPrimop primop args)

                   pure [reg]

           ReturnsTuple

                   pure regs

         f res_kind regs

         emitReturn (map (CmmReg . CmmLocal) regs)

 import GHC.Prelude hiding ( head, init, last, tail )

 import GHC.Platform

 import GHC.StgToCmm.Monad

 import GHC.StgToCmm.Closure

 import GHC.StgToCmm.Lit (mkSimpleLit, newStringCLit)

 import GHC.Types.ForeignCall

 import GHC.Types.Id.Info

 import GHC.Core.TyCon

 import GHC.Runtime.Heap.Layout

 import GHC.Unit

 import GHC.Data.FastString

 import GHC.Utils.Outputable

 import GHC.Utils.Panic

 import GHC.Types.CostCentre

 import GHC.Types.IPE

                   ; emitAssign (CmmLocal reg) e

                   ; return reg }

 -- Choose suitable local regs to use for the components

 -- of an unboxed tuple that we are about to return to

 -- the Sequel.  If the Sequel is a join point, using the

 -- regs it wants will save later assignments.

 newUnboxedTupleRegs res_kind

 -------------------------------------------------------------------------

 --      emitMultiAssign

   where

     result       = result_reps `zip` result_slots

     result_slots = fmap (slotCount . primRepSize) result_reps

 -- | Ensure that the set of identifiers has valid 'RuntimeRep's. This function

 -- returns a no-op when 'csRuntimeAssert' in 'StgToJSConfig' is False.

 typeJSRep t = map primRepToJSRep (typePrimRep t)

 stgKindJSRep :: HasDebugCallStack => StgKind -> [JSRep]

 -- only use if you know it's not an unboxed tuple

 unaryTypeJSRep :: HasDebugCallStack => UnaryType -> JSRep