StgOpApp (StgPrimOp op) stg_args res_ty

       -- A call to some primitive Cmm function.

                                 PrimCallConv _))

                        -> assert exactly_saturated $

                           StgOpApp (StgPrimCallOp (PrimCall lbl (staticTargetUnit ext))) stg_args res_ty

 import Language.Haskell.Syntax.Binds

 import Language.Haskell.Syntax.Decls

 import Language.Haskell.Syntax.Decls.Overlap (OverlapMode(..))

 import Language.Haskell.Syntax.Extension

       pprCEntity (CLabel lbl) _ =

         doubleQuotes $ text "static" <+> pp_hdr <+> char '&' <> ppr lbl

         if dqNeeded then doubleQuotes ce else empty

           where

             st = case ghcPass @p of

                     GhcTc -> staticTargetLabel stExt

             dqNeeded = (take 6 src == "static")

                     || isJust mHeader

                     || st /= NoSourceText

             ce =

                   -- We may need to drop leading spaces first

                   (if take 6 src == "static" then text "static" else empty)

               <+> pp_hdr

               <+> (pprWithSourceText st empty)

       pprCEntity (CFunction DynamicTarget{}) _ =

         doubleQuotes $ text "dynamic"

 import GHC.Types.InlinePragma (ActivationGhc)

 import GHC.Data.BooleanFormula (BooleanFormula(..))

 import Language.Haskell.Syntax.Decls

 import Language.Haskell.Syntax.Decls.Overlap (OverlapMode(..))

 import Language.Haskell.Syntax.Extension (Anno)

 import Language.Haskell.Syntax.Binds.InlinePragma (ActivationX(..), InlinePragma(..))

 import GHC.Hs

 import GHC.HsToCore.Pmc.Solver.Types

 import GHC.Types.Error

 import GHC.Types.Id

 import GHC.Types.InlinePragma (ActivationGhc)

 import GHC.Types.Name (Name)

                                 -- from C, and its representation type

           -> CLabelString       -- The name to export to C land

           -> CCallConv

                                 --         so invoke IO action that's hanging off

                                 --         the first argument's stable pointer

           -> DsM ( CHeader      -- contents of Module_stub.h

                  , String       -- string describing type to pass to createAdj.

                  )

     let

        ty                     = coercionRKind co

        (bndrs, orig_res_ty)   = tcSplitPiTys ty

        fe_arg_tys'            = mapMaybe anonPiTyBinderType_maybe bndrs

        -- We must use tcSplits here, because we want to see

        -- the (IO t) in the corner of the type!

        -- Look at the result type of the exported function, orig_res_ty

        (res_ty, is_IO_res_ty) = case tcSplitIOType_maybe orig_res_ty of

                                 -- The function already returns IO t

                                 -- The function returns t

     dflags <- getDynFlags

     return $

       mkFExportCBits dflags ext_name

                      fe_arg_tys res_ty is_IO_res_ty cconv

 dsCImport :: Id

         export_ty     = mkVisFunTyMany stable_ptr_ty arg_ty

     bindIOId <- dsLookupGlobalId bindIOName

     stbl_value <- newSysLocalMDs stable_ptr_ty

     let

          {-

           The arguments to the external function which will

     (fcall', cDoc) <-

               case fcall of

                                CApiConv safety) ->

                do nextWrapperNum <- ds_next_wrapper_num <$> getGblEnv

                   wrapperName <- mkWrapperName nextWrapperNum "ghc_wrapper" (unpackFS cName)

                   let fcall' = CCall (CCallSpec

                                       (StaticTarget (stExt { staticTargetLabel = NoSourceText} )

                                                     wrapperName

                                       CApiConv safety)

                       c = includes

                        $$ fun_proto <+> braces (cRet <> semi)

                                       | Header _ h <- nub headers ]

                       fun_proto = constQual <+> cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes

                       cRet

                       cCall

                         | null arg_tys = ppr cName

                         | otherwise = panic "dsFCall: Unexpected arguments to FFI value import"

                       raw_res_ty = case tcSplitIOType_maybe io_res_ty of

                -> Maybe Id      -- Just==static, Nothing==dynamic

                -> [Type]

                -> Type

                -> CCallConv

                -> (CHeader,

                    CStub,

                    String       -- the argument reps

                   )

  =

    ( header_bits

    , CStub body [] []

                 char '&' <> cap <>

                 text "rts_apply" <> parens (

                     cap

                       then text "ghc_hs_iface->runIO_closure"

                       else text "ghc_hs_iface->runNonIO_closure")

                  <> comma

              { staticTargetLabel = NoSourceText

              , staticTargetUnit  = unit

              }

            the_fcall    = CCall (CCallSpec target CCallConv may_gc)

            the_prim_app = mkFCall uniq the_fcall unboxed_args ccall_result_ty

        return (foldr ($) (res_wrapper the_prim_app) arg_wrappers)

 import GHC.Hs

 import GHC.Types.Id

 import GHC.Types.ForeignStubs

 import GHC.Unit.Module

 import GHC.Core.Coercion

                           , fd_e_ext = co

                           , fd_fe = CExport _

                               (L _ (CExportStatic ext_nm cconv)) }) = do

       return (h, c, ids, bs)

 {-

                                 -- from C, and its representation type

           -> CLabelString       -- The name to export to C land

           -> CCallConv

                                 --         so invoke IO action that's hanging off

                                 --         the first argument's stable pointer

           -> DsM ( CHeader      -- contents of Module_stub.h

                  , [Id]         -- function closures to be registered as GC roots

                  , [Binding]    -- additional bindings used by desugared foreign export

                  )

   platform <- getPlatform

   case (platformArch platform, cconv) of

     (ArchJavaScript, _) -> do

       pure (h, c, ts, [fn_id], [])

     (ArchWasm32, JavaScriptCallConv) ->

       dsWasmJSExport fn_id co ext_name

     _ -> do

       pure (h, c, ts, [fn_id], [])

                         -- from C, and its representation type

   -> CLabelString       -- The name to export to C land

   -> CCallConv

                         --         so invoke IO action that's hanging off

                         --         the first argument's stable pointer

   -> DsM ( CHeader      -- contents of Module_stub.h

          , String       -- string describing type to pass to createAdj.

          )

     let

        ty                              = coercionRKind co

        (_tvs,sans_foralls)             = tcSplitForAllTyVars ty

        (fe_arg_tys', orig_res_ty)      = tcSplitFunTys sans_foralls

        -- We must use tcSplits here, because we want to see

        -- the (IO t) in the corner of the type!

        -- Look at the result type of the exported function, orig_res_ty

        -- If it's IO t, return         (t, True)

     platform <- targetPlatform <$> getDynFlags

     return $

       mkFExportJSBits platform ext_name

                      (map scaledThing fe_arg_tys) res_ty is_IO_res_ty cconv

 mkFExportJSBits

         export_ty     = mkVisFunTyMany stable_ptr_ty arg_ty

     bindIOId <- dsLookupGlobalId bindIOName

     stbl_value <- newSysLocalMDs stable_ptr_ty

     let

          {-

           The arguments to the external function which will

         , staticTargetUnit  = ghcInternalUnit

         }

     ccall = CCall $ CCallSpec

               JavaScriptCallConv

               PlayRisky

   let cfun_fcall =

         CCall

           ( CCallSpec

               CCallConv

               -- Same even for foreign import javascript unsafe, for

               -- the sake of re-entrancy.

 import GHC.Types.SrcLoc as SrcLoc

 import GHC.Types.Unique

 import GHC.Types.Var

 import GHC.Types.Id

 import GHC.Types.InlinePragma

 import GHC.Types.SourceText

     conv_cimportspec (CLabel cls)

       = notHandled (ThForeignLabel cls)

     conv_cimportspec (CFunction (DynamicTarget{})) = return "dynamic"

                             = return (unpackFS fs)

                             = panic "conv_cimportspec: values not supported yet"

     conv_cimportspec CWrapper = return "wrapper"

     -- these calling conventions do not support headers and the static keyword

 import GHC.Types.Basic

 import GHC.Types.Error

 import GHC.Types.Fixity

 import GHC.Types.Hint

 import GHC.Types.InlinePragma

 import GHC.Types.SourceText

         entity'    = if nullFS entity

                         then mkExtName (unLoc v)

                         else entity

         importSpec = CImport (L (l2l loc) esrc) (reLoc cconv) (reLoc safety) Nothing funcTarget

     returnSpec spec = return $ \tforeign -> ForD noExtField $ ForeignImport

    id_char       c = isAlphaNum c || c == '_'

    cimp nm = (ReadP.char '&' >> skipSpaces >> CLabel <$> cid)

                                CApiConv ->

                                          (do token "value"

                                              skipSpaces

                      cid' <- cid

           where

             cid = return nm +++

                   (do c  <- satisfy id_first_char

 import GHC.Types.FieldLabel

 import GHC.Types.Name.Reader

 import GHC.Types.Name

 import GHC.Types.Name.Set

 import GHC.Types.Name.Env

 patchCCallTarget :: Unit -> CCallTarget GhcPs -> CCallTarget GhcRn

 patchCCallTarget unit = \case

     DynamicTarget x -> DynamicTarget x

       let ext = StaticTargetGhc

             { staticTargetLabel = sTxt

             , staticTargetUnit  = unit

             }

 {-

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

          maybe_static_target =

              case target of

                  DynamicTarget{} -> Nothing

                    panic "generateCCall: unexpected FFI value import"

                    Just (LitLabel target IsFunction)

      let

         ; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty

         ; let ((call_args, arg_hints), cmm_target)

                 = case target of

                         panic "cgForeignCall: unexpected FFI value import"

                         let labelSource =

                               ForeignLabelInPackage . toUnitId $ staticTargetUnit ext

                         in  ( unzip cmm_args

                -> [StgArg]

                -> G (JStgStat, ExprResult)

 genForeignCall _ctx

                                    JavaScriptCallConv

                                    PlayRisky))

                _t

 import GHC.Types.Error

 import GHC.Types.Avail

 import GHC.Types.Hint

 import GHC.Types.Id.Info ( RecSelParent(..) )

 import GHC.Types.InlinePragma (InlinePragma(..))

 import GHC.Types.Name (NamedThing(..), Name, OccName, getSrcLoc, getSrcSpan)

       checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty

       checkMissingAmpersand idecl target (map scaledThing arg_tys) res_ty

       case target of

            | not (null arg_tys) ->

               addErrTc (TcRnForeignFunctionImportAsValue idecl)

           _ -> return ()

 checkCTarget _ (DynamicTarget{}) = panic "checkCTarget DynamicTarget"

 checkMissingAmpersand :: ForeignImport GhcRn -> CCallTarget GhcRn -> [Type] -> Type -> TcM ()

 checkMissingAmpersand idecl _ arg_tys res_ty

   | null arg_tys && isFunPtrTy res_ty

 import GHC.Data.FastString  ( FastString )

 import GHC.Utils.Outputable ( Outputable(..) )

 import Language.Haskell.Syntax

 import GHC.Boot.TH.Syntax qualified as TH

 import qualified Data.List.NonEmpty as NE

 import GHC.Builtin.Types.Prim( fUNTyCon )

 import GHC.Hs.Decls.Overlap as Hs

 import GHC.Types.Basic as Hs

 import GHC.Types.InlinePragma as Hs

 import GHC.Types.Unique

 import GHC.Types.SourceText

                         (StaticTarget

                           (SourceText fromtxt)

                           fromtxt

                         )

                       )

                     )

 -}

 module GHC.Types.ForeignCall (

         Safety(..), playSafe, playInterruptible,

         CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,

         CCallSpec(..),

         CCallTarget(..), isDynamicTarget,

         CCallConv(..), defaultCCallConv, ccallConvAttribute,

         Header(..), CType(..),

         StaticTargetGhc(..),

 import Language.Haskell.Syntax.Decls.ForeignCall

   (CCallConv(..), CCallTarget(..), CExportSpec(..), CLabelString,

 import Language.Haskell.Syntax.Extension

 import Data.Char

 import Data.Data (Data)

 import Control.DeepSeq (NFData(..))

       ppr_fun = \case

         DynamicTarget{} -> text "__ffi_dyn_ccall" <> gc_suf <+> text "\"\""

         st@(StaticTarget _ label isFun) ->

               (srcTxt, pPkgId) = case ghcPass @p of

                 GhcPs | StaticTarget ext _ _ <- st -> (ext, empty)

                 GhcRn | StaticTarget ext _ _ <- st -> (staticTargetLabel ext, ppr $ staticTargetUnit ext)

       fs <- get bh

       return (CType s mh fs)

 instance Binary Header where

     put_ bh (Header s h) = put_ bh s >> put_ bh h

     get bh = do

 -- | Abstract syntax of global declarations.

 --

 -- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,

 module Language.Haskell.Syntax.Decls (

   -- * Toplevel declarations

   HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..),

   -- ** Template haskell declaration splice

   SpliceDecoration(..),

   SpliceDecl(..), LSpliceDecl,

   -- ** Foreign function interface declarations

   ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),

   CCallConv(..), CCallTarget(..), CExportSpec(..), CImportSpec(..), CLabelString,

   CType(..), Header(..), Safety(..),

   -- ** Data-constructor declarations

   ConDecl(..), LConDecl,

   HsConDeclH98Details,

 import GHC.Data.FastString (FastString)

 import GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST

 import GHC.Hs.Doc (WithHsDocIdentifiers)

 import Control.DeepSeq

 import Control.Monad

 -- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,

 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.

 module Language.Haskell.Syntax.Decls.ForeignCall (

   CCallConv(..), CCallTarget(..), CExportSpec(..), CImportSpec(..), CLabelString,

   CType(..), Header(..), Safety(..),

 import Data.Data        hiding (TyCon, Fixity, Infix)

 import Data.Maybe

 import Data.Eq

 import Prelude (Enum, Show, seq)

 {-

   | StdCallConv

   | PrimCallConv

   | JavaScriptCallConv

 instance NFData CCallConv where

 -- | How to call a particular function in C-land.

 data CCallTarget pass

         (XStaticTarget pass)

         CLabelString -- C-land name of label.

                      --    Used when importing a label as "foreign import ccall "dynamic" ..."

                      -- False => a value; only

                      -- allowed in CAPI imports