-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ _ CWrapper)
- = -- Foreign wrapper (former f.e.d.)
- -- The type must be of the form ft -> IO (FunPtr ft), where ft is a
- -- valid foreign type. For legacy reasons ft -> IO (Ptr ft) as well
- -- as ft -> IO Addr is accepted, too. The use of the latter two forms
- -- is DEPRECATED, though.
- checkCg checkCOrAsmOrInterp `thenM_`
- checkCConv cconv `thenM_`
- (case arg_tys of
- [arg1_ty] -> checkForeignArgs isFFIExternalTy arg1_tys `thenM_`
- checkForeignRes nonIOok isFFIExportResultTy res1_ty `thenM_`
- checkForeignRes mustBeIO isFFIDynResultTy res_ty `thenM_`
- checkFEDArgs arg1_tys
- where
- (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
- other -> addErrTc (illegalForeignTyErr empty sig_ty) ) `thenM_`
- return idecl
+tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction target))
+ | isDynamicTarget target = do -- Foreign import dynamic
+ checkCg checkCOrAsmOrLlvmOrInterp
+ checkCConv cconv
+ checkSafety safety
+ case arg_tys of -- The first arg must be Ptr, FunPtr, or Addr
+ [] -> do
+ check False (illegalForeignTyErr empty sig_ty)
+ return idecl
+ (arg1_ty:arg_tys) -> do
+ dflags <- getDOpts
+ check (isFFIDynArgumentTy arg1_ty)
+ (illegalForeignTyErr argument arg1_ty)
+ checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
+ checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty
+ return idecl
+ | cconv == PrimCallConv = do
+ dflags <- getDOpts
+ check (xopt Opt_GHCForeignImportPrim dflags)
+ (text "Use -XGHCForeignImportPrim to allow `foreign import prim'.")
+ checkCg (checkCOrAsmOrLlvmOrDotNetOrInterp)
+ checkCTarget target
+ check (playSafe safety)
+ (text "The safe/unsafe annotation should not be used with `foreign import prim'.")
+ checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys
+ -- prim import result is more liberal, allows (#,,#)
+ checkForeignRes nonIOok (isFFIPrimResultTy dflags) res_ty
+ return idecl
+ | otherwise = do -- Normal foreign import
+ checkCg (checkCOrAsmOrLlvmOrDotNetOrInterp)
+ checkCConv cconv
+ checkSafety safety
+ checkCTarget target
+ dflags <- getDOpts
+ checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
+ checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty
+ checkMissingAmpersand dflags arg_tys res_ty
+ return idecl