-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ (CFunction target))
- | isDynamicTarget target -- Foreign import dynamic
- = checkCg checkCOrAsmOrInterp `thenM_`
- checkCConv cconv `thenM_`
- case arg_tys of -- The first arg must be Ptr, FunPtr, or Addr
- [] ->
- check False (illegalForeignTyErr empty sig_ty) `thenM_`
- return idecl
- (arg1_ty:arg_tys) ->
- getDOpts `thenM` \ dflags ->
- check (isFFIDynArgumentTy arg1_ty)
- (illegalForeignTyErr argument arg1_ty) `thenM_`
- checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys `thenM_`
- checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty `thenM_`
- return idecl
- | otherwise -- Normal foreign import
- = checkCg (checkCOrAsmOrDotNetOrInterp) `thenM_`
- checkCConv cconv `thenM_`
- checkCTarget target `thenM_`
- getDOpts `thenM` \ dflags ->
- checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys `thenM_`
- checkForeignRes nonIOok (isFFIImportResultTy dflags) res_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 (dopt 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
+