-- A regular foreign call.

       FCallId call     -> assert exactly_saturated $

       TickBoxOpId {}   -> pprPanic "coreToStg TickBox" $ ppr (f,stg_args)

     let mk_rhs = MkStgRhs

           { rhs_args = args'

           , 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) =

 import GHC.Unit.Module

 import GHC.Core.DataCon

 import GHC.Stg.Syntax

 import GHC.Stg.Utils (stripStgTicksTop)

 data MkStgRhs = MkStgRhs

   { rhs_args :: [Id]     -- ^ Empty for thunks

   , rhs_expr :: StgExpr  -- ^ RHS expression

   , rhs_is_join :: !Bool -- ^ Is it a RHS for a join-point?

   }

 mkTopStgRhs :: (Module -> DataCon -> [StgArg] -> Bool)

             -> Bool -> Module -> CollectedCCs

             -> Id -> MkStgRhs -> (StgRhs, CollectedCCs)

   -- try to make a StgRhsCon first

   | Just rhs_con <- mkTopStgRhsCon_maybe (allow_toplevel_con_app this_mod) mk_rhs

   = ( rhs_con, ccs )

     ( StgRhsClosure noExtFieldSilent

                     dontCareCCS

                     ReEntrant

     , ccs )

   -- Otherwise it's a CAF, see Note [Cost-centre initialization plan].

   | opt_AutoSccsOnIndividualCafs

   = ( StgRhsClosure noExtFieldSilent

                     caf_ccs

     , collectCC caf_cc caf_ccs ccs )

   | otherwise

   = ( StgRhsClosure noExtFieldSilent

                     all_cafs_ccs

     , ccs )

   where

 -- Generate a non-top-level RHS. Cost-centre is always currentCCS,

 -- see Note [Cost-centre initialization plan].

 mkStgRhs :: Id -> MkStgRhs -> StgRhs

   -- try to make a StgRhsCon first

   | Just rhs_con <- mkStgRhsCon_maybe mk_rhs

   = rhs_con

   | otherwise

   = StgRhsClosure noExtFieldSilent

                   currentCCS

   where

     upd_flag | is_join                             = JumpedTo

              | not (null bndrs)                    = ReEntrant

 -- | Try to make a non top-level StgRhsCon if appropriate

 mkStgRhsCon_maybe :: MkStgRhs -> Maybe StgRhs

   | [] <- bndrs

   , not is_join

   , (ticks, StgConApp con mn args _) <- stripStgTicksTop (not . tickishIsCode) rhs

   | otherwise = Nothing

 -- | Try to make a top-level StgRhsCon if appropriate

 mkTopStgRhsCon_maybe :: (DataCon -> [StgArg] -> Bool) -> MkStgRhs -> Maybe StgRhs

   | [] <- bndrs

   , not is_join -- shouldn't happen at top-level

   , (ticks, StgConApp con mn args _) <- stripStgTicksTop (not . tickishIsCode) rhs

   , allow_static_con_app con args

   | otherwise = Nothing

 module GHC.Stg.Syntax (

         StgKind(..),

         StgArg(..),

         GenStgTopBinding(..), GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),

 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 Data.Data   ( Data )

 import Data.List   ( intersperse )

 import GHC.Tc.Utils.TcType (Kind)

 newtype StgKind = MkStgKind { getStgKind :: Kind }

         [BinderP pass]     -- ^ arguments; if empty, then not a function;

                            --   as above, order is important.

         (GenStgExpr pass)  -- ^ body

 {-

 An example may be in order.  Consider:

         ConstructorNumber

         [StgTickish]

         [StgArg]        -- Saturated Args. See Note [Constructor applications in STG]

 -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that

 -- returns 'empty'.

 isUpdatable Updatable   = True

 isUpdatable JumpedTo    = False

 {-

 ************************************************************************

 *                                                                      *

   | StgPrimCallOp PrimCall

   | StgTagToEnumOp TyCon

 pprStgOp (StgPrimOp  op)   = ppr op

 pprStgOp (StgPrimCallOp op)= ppr op

 pprStgOp (StgFCallOp op _) = ppr op

 instance Outputable StgOp where

   ppr = pprStgOp

   = StgRec <$> mapM (\(x, rhs) -> (x,) <$> unariseRhs rho top_level rhs) xrhss

 unariseRhs :: UnariseEnv -> Bool -> StgRhs -> UniqSM StgRhs

   = do (rho', args1) <- unariseFunArgBinders rho args

        expr' <- unariseExpr rho' expr

        -- Unarisation can lead to a StgRhsClosure becoming a StgRhsCon.

        let mk_rhs = MkStgRhs

             { rhs_args = args1

             , rhs_expr = expr'

             , rhs_is_join = update_flag == JumpedTo

             }

        if | top_level

           -> pure rhs_con

           | otherwise

 unariseRhs rho _top (StgRhsCon ccs con mu ts args typ)

   = assert (not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con))

 import GHC.Utils.Logger

 import GHC.Types.Var.Set

 import GHC.Builtin.Types.Prim

 import GHC.Utils.Error

 import GHC.Builtin.Uniques

 import GHC.Data.FastString

 maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (StgArg, [Name])

 -- Detect and extract relevant info for the tagToEnum kludge.

   | [v] <- args

   = Just (v, extract_constr_Names tyc)

   | otherwise

     -- See Note [Inlining out-of-line primops and heap checks]

     return $! shouldInlinePrimOp cfg op arg_exprs

 isSimpleOp (StgPrimCallOp _) _                           = return False

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

 chooseReturnBndrs :: Id -> AltType -> [CgStgAlt] -> [NonVoid Id]

 import GHC.Cmm.Utils

 import GHC.Cmm.Graph

 import GHC.Cmm.CallConv

 import GHC.Types.RepType

 import GHC.Cmm.CLabel

 import GHC.Runtime.Heap.Layout

 import GHC.Types.Unique.DSM

 import GHC.Unit.Types

 import GHC.Utils.Misc (zipEqual)

 import Control.Monad

 -- Precondition: the length of the arguments list is the same as the

 -- arity of the foreign function.

 cgForeignCall :: ForeignCall            -- the op

               -> [StgArg]               -- x,y    arguments

               -> StgKind                -- result kind

               -> FCode ReturnKind

         -- ; traceM $ show cmm_args

         ; (res_regs, res_hints) <- newUnboxedTupleRegs (getStgKind res_kind)

         ; let ((call_args, arg_hints), cmm_target)

 getFCallArgs ::

      [StgArg]

   -> FCode [(CmmExpr, ForeignHint)]

 -- (a) Drop void args

 -- (b) Add foreign-call shim code

 -- It's (b) that makes this differ from getNonVoidArgAmodes

 -- Precondition: args and typs have the same length

 -- See Note [Unlifted boxed arguments to foreign calls]

         ; return (catMaybes mb_cmms) }

   where

     get (arg,typ)

         arg_reps = typePrimRep arg_ty

         hint     = typeForeignHint arg_ty

 -- See Note [Unlifted boxed arguments to foreign calls]

 add_shim :: Profile -> StgFArgType -> CmmExpr -> CmmExpr

 add_shim profile ty expr = case ty of

   StgByteArrayType  -> cmmOffsetB platform expr (arrWordsHdrSize profile)

   where

     platform = profilePlatform profile

 import GHC.Cmm

 import GHC.Unit         ( rtsUnit )

 import GHC.Core.Type    ( typeKind )

 import GHC.Cmm.CLabel

 import GHC.Cmm.Info     ( closureInfoPtr )

 import GHC.Cmm.Utils

         ; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))

         ; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }

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

 cmmPrimOpApp cfg primop cmm_args mres_ty =

   case emitPrimOp cfg primop cmm_args of

   -- tagToEnum# is removed in CoreToStg and rewritten to a special StgTagToEnumOp

   -- See Note [?]

 -- Out of line primops.

 -- TODO compiler need not know about these

          -> StgReg

          -> [Id]

          -> CgStgExpr

          -> G JStgStat

   -- load arguments into local variables

   la <- do

     args' <- concatMapM genIdArgI args

   -- compute PrimReps and their number of slots required to return the result of

   -- i applied to args.

   -- compute typed expressions for each slot and assign registers

   let go_var regs = \case

   return $ la <> lav <> e <> returnStack

 -- | Find the result type after applying the function to the arguments

 --

 -- It's trickier than it looks because:

 -- In case of failure to determine the type, we default to LiftedRep as it's

 -- probably what it is.

 --

   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.

 genTagToEnumOp :: ExprCtx -> TyCon -> StgArg -> State.StateT GenState IO (JStgStat, ExprResult)

 genTagToEnumOp ctx tyc arg = do