-- stores the type constructor information. See Note [tagToEnum# in STG]

       -- in GHC.Stg.Syntax.

       PrimOpId TagToEnumOp _ -> 

       -- Some primitive operator that might be implemented as a library call.

       -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps

       -- we require that primop applications be saturated.

       PrimOpId op _    -> -- assertPpr saturated (ppr f <+> ppr stg_args) $

       -- A call to some primitive Cmm function.

       FCallId (CCall (CCallSpec

                             (StaticTarget ext lbl ForeignFunction) PrimCallConv _))

                             | TargetIsInThat unit <- staticTargetUnit ext

                        -> assert exactly_saturated $

       -- A regular foreign call.

       FCallId call     -> assert exactly_saturated $

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

         args' = substArgs env args

 stgCseExpr _ (StgLit lit)

     = StgLit lit

   where args' = substArgs env args

 stgCseExpr env (StgTick tick body)

     = let body' = stgCseExpr env body

     go (StgConApp dc _mn as tys) = do

       n' <- numberDataCon dc []

       return (StgConApp dc n' as tys)

     go (StgCase scrut bndr ty alts) =

       StgCase <$> collectExpr scrut <*> pure bndr <*> pure ty <*> mapM collectAlt alts

     go (StgLet ext bind body) = do

   where

     (info, body') = inferTagExpr env body

   -- Which primops guarantee to return a properly tagged value?

   -- Probably none, and that is the conservative assumption anyway.

   -- (And foreign calls definitely need not make promises.)

 inferTagExpr env (StgLet ext bind body)

   = (info, StgLet ext bind' body')

 rewriteExpr e@(StgConApp {})          = rewriteConApp e

 rewriteExpr e@(StgApp {})             = rewriteApp e

 rewriteExpr (StgLit lit)              = return $! (StgLit lit)

 rewriteCase :: InferStgExpr -> RM TgStgExpr

 -}

 rewriteOpApp :: InferStgExpr -> RM TgStgExpr

   op@(StgPrimOp primOp)

     | primOp == DataToTagSmallOp || primOp == DataToTagLargeOp

     -- see Note [Rewriting primop arguments]

 rewriteOpApp _ = panic "Impossible"

 -- `mkSeq` x x' e generates `case x of x' -> e`

       | (imp_fvs, top_fvs, lcl_fvs) <- argsFVs env as

       = (StgConApp dc n as tys, imp_fvs, top_fvs, lcl_fvs)

       | (imp_fvs, top_fvs, lcl_fvs) <- argsFVs env as

     go (StgCase scrut bndr ty alts)

       | (scrut',scrut_imp_fvs,scrut_top_fvs,scrut_lcl_fvs) <- exprFVs env scrut

   let top_lvl_args = map StgVarArg fvs' ++ args'

   pure (StgApp f' top_lvl_args)

 liftExpr (StgConApp con mn args tys) = StgConApp con mn <$> traverse liftArgs args <*> pure tys

 liftExpr (StgCase scrut info ty alts) = do

   scrut' <- liftExpr scrut

   withSubstBndr (binderInfoBndr info) $ \bndr' -> do

   = (NilSk, emptyVarSet, StgLit lit)

 tagSkeletonExpr (StgConApp con mn args tys)

   = (NilSk, mkArgOccs args, StgConApp con mn args tys)

 tagSkeletonExpr (StgApp f args)

   = (NilSk, arg_occs, StgApp f args)

   where

     opts <- getStgPprOpts

     lintConApp con args (pprStgExpr opts app)

     mapM_ lintStgFunArg args

 lintStgExpr (StgLet _ binds body) = do

 statExpr (StgApp _ _)     = countOne Applications

 statExpr (StgLit _)       = countOne Literals

 statExpr (StgConApp {})   = countOne ConstructorApps

 statExpr (StgTick _ e)    = statExpr e

 statExpr (StgLetNoEscape _ binds body)

   | StgOpApp    StgOp    -- Primitive op or foreign call

                 [StgArg] -- Saturated.

 {-

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

 data StgOp

   = StgPrimOp  PrimOp

         -- The foreign argument types, which are obtained from the foreign

         -- import declaration itself, areneeded by the stg-to-cmm pass to

         -- determine the offset to apply to unlifted boxed arguments in

       -> ppr func <> ppr sig

       | otherwise -> hang (ppr func) 4 (interppSP args) -- TODO: Print taggedness

    StgConApp con n args _ -> hsep [ ppr con, ppr n, brackets (interppSP args) ]

 -- special case: let v = <very specific thing>

 --               in

 pprStgOp :: StgOp -> SDoc

 pprStgOp (StgPrimOp  op)   = ppr op

 -- TODO: how do we want to pretty print this?

 pprStgOp (StgTagToEnumOp tyc) = text "TagToEnumOp" <+> ppr tyc

       let args' = unariseConArgs rho args in

       return $ (StgConApp dc n args' [])

 unariseExpr rho (StgCase scrut bndr alt_ty alts)

   -- tuple/sum binders in the scrutinee can always be eliminated

 mkCast :: StgArg -> PrimOp -> OutId -> StgKind -> StgExpr -> StgExpr

 mkCast arg_in cast_op out_id out_kind in_rhs =

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

       alt_ty = PrimAlt (stgKindPrimRep1 out_kind)

   in (StgCase scrut out_id alt_ty [alt])

    = implement_tagToId d s p arg constr_names

    -- Case 1

    = if isSupportedCConv ccall_spec

       then generateCCall d s p ccall_spec kind args

       else unsupportedCConvException

   profile <- getProfile

   let platform = profilePlatform profile

   case doPrimOp platform op d s p args of

     -- Otherwise we have to do a call to the primop wrapper instead :(

     _         -> doTailCall d s p (primOpId op) (reverse args)

    = generatePrimCall d s p label args

 schemeT d s p (StgConApp con _cn args _tys)

 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

 -- dataToTagSmall# :: a_levpoly -> Int#

 -- See Note [DataToTag overview] in GHC.Tc.Instance.Class,

 -- particularly wrinkles H3 and DTW4

   platform <- getPlatform

   emitComment (mkFastString "dataToTagSmall#")

 -- dataToTagLarge# :: a_levpoly -> Int#

 -- See Note [DataToTag overview] in GHC.Tc.Instance.Class,

 -- particularly wrinkles H3 and DTW4

   platform <- getPlatform

   emitComment (mkFastString "dataToTagLarge#")

   emitReturn [CmmReg $ CmmLocal result_reg]

 cgExpr (StgConApp con mn args _) = cgConApp con mn args

 cgExpr (StgTick t e)         = cgTick t >> cgExpr e

 cgExpr (StgLit lit)          = do cmm_expr <- cgLit lit

        ; cgAlts (gc_plan,ret_kind) (NonVoid bndr) alt_type alts

        }

   where

     is_cmp_op _                             = False

 -- heap usage from alternatives into the stuff before the case

 -- NB: if you get this wrong, and claim that the expression doesn't allocate

 --     when it does, you'll deeply mess up allocation

 isSimpleScrut (StgLit _)           _         = return True       -- case 1# of { 0# -> ..; ... }

 isSimpleScrut (StgApp _ [])    (PrimAlt _)   = return True       -- case x# of { 0# -> ..; ... }

 isSimpleScrut (StgApp f [])   _

 isSimpleOp :: StgOp -> [StgArg] -> FCode Bool

 -- True iff the op cannot block or allocate

 -- dataToTagSmall#/dataToTagLarge# evaluate an argument;

 -- see Note [DataToTag overview] in GHC.Tc.Instance.Class

 isSimpleOp (StgPrimOp DataToTagSmallOp) _ = return False

     cfg       <- getStgToCmmConfig

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

     return $! shouldInlinePrimOp cfg op arg_exprs

 isSimpleOp (StgTagToEnumOp _) _ = return True

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

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

 cgOpApp :: StgOp        -- The op

         -> [StgArg]     -- Arguments

         -> FCode ReturnKind

 -- Foreign calls

   = cgForeignCall fcall ty stg_args res_kind

       -- See Note [Foreign call results]

     cfg <- getStgToCmmConfig

     cmm_args <- getNonVoidArgAmodes args

   = do  { cmm_args <- getNonVoidArgAmodes args

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

         ; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }

 -- tagToEnum# is special: we need to pull the constructor

 -- out of the table, and perform an appropriate return.

   amodes <- getNonVoidArgAmodes args

   case amodes of

     [amode] -> do

       emitReturn [tagToClosure platform tyc amode]

     _ -> pprPanic "cgOpApp: tagToEnum# should be applied to exactly one argument" (ppr args)

   case emitPrimOp cfg primop cmm_args of

     PrimopCmmEmit_Internal f ->

       let

       in emitReturn =<< f res_ty

     PrimopCmmEmit_External -> do

       let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))

       p   <- newTemp t

       -- 1) compute the multiplication as if numbers were unsigned

       _ <- withSequel (AssignTo [p, res_l] False) $

       -- 2) correct the high bits of the unsigned result

       let carryFill x = CmmMachOp (MO_S_Shr ww) [x, wwm1]

           sub x y     = CmmMachOp (MO_Sub   ww) [x, y]

     rangeTooLargeReg <- newTemp (bWord platform)

     lastSafeIndexReg <- newTemp (bWord platform)

     _ <- withSequel (AssignTo [lastSafeIndexReg, rangeTooLargeReg] False) $

     boundsCheckFailed <- getCode $

       emitCCallNeverReturns [] (mkLblExpr mkOutOfBoundsAccessLabel) []

     let

     as <- concatMapM genArg args

     c <- genCon ctx con as

     return (c, ExprInline)

     -> genForeignCall ctx f k (concatMap typex_expr $ ctxTarget ctx) args

     -> genPrimOp ctx op args

     -> genPrimCall ctx c args k

   StgCase e b at alts

     -> genCase ctx b e at alts (liveVars $ stgExprLive False stg)

   StgLet _ b e -> do

         -> x : concatMap collectArgsA args

       StgConApp _con _mn args _ts

         -> concatMap collectArgsA args

         -> concatMap collectArgsA args

       StgCase e _b _a alts

         -> collectArgsE e ++ concatMap collectArgsAlt alts

     -- No args

     processStgExpr (StgApp _ []) = Nothing

     processStgExpr (StgConApp _ _ [] _) = Nothing

     -- Main targets. Preserving the order of args is important

     processStgExpr (StgApp fn args@(_:_))

       | otherwise = Just (StgConApp dc n unified tys, names)

       where

         (unified, names) = substituteArgWithNames args

       | isEmptyUniqSet names = Nothing

       where

         (unified, names) = substituteArgWithNames args

 exprRefs u = \case

   StgApp f args             -> s f <> l (argRefs u) args

   StgConApp d _n args _     -> l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args

   StgLit {}                 -> mempty

   StgCase expr _ _ alts     -> exprRefs u expr <> mconcat (fmap (altRefs u) alts)

   StgLet _ bnd expr         -> bindingRefs u bnd <> exprRefs u expr

   StgApp occ args -> unionDVarSets (unitDVarSet occ : map stgArgLive args)

   StgLit {}       -> emptyDVarSet

   StgConApp _dc _n args _tys -> unionDVarSets (map stgArgLive args)

   StgCase e b _at alts

     | includeLHS -> el `unionDVarSet` delDVarSet al b

     | otherwise  -> delDVarSet al b

     -> True

   StgConApp{}

     -> True

     -> isInlineForeignCall f

     -> primOpIsReallyInline op

     -> True

   StgCase e _ _ alts

     ->let ie   = isInlineExpr e