+ mapAndUnzipTc tcFImport
+ [ foreign_decl | ForD foreign_decl <- decls, isForeignImport foreign_decl]
+
+tcFImport :: RenamedForeignDecl -> TcM (Id, TypecheckedForeignDecl)
+tcFImport fo@(ForeignImport nm hs_ty imp_decl isDeprec src_loc)
+ = tcAddSrcLoc src_loc $
+ tcAddErrCtxt (foreignDeclCtxt fo) $
+ tcHsSigType (ForSigCtxt nm) hs_ty `thenTc` \ sig_ty ->
+ let
+ -- drop the foralls before inspecting the structure
+ -- of the foreign type.
+ (_, t_ty) = tcSplitForAllTys sig_ty
+ (arg_tys, res_ty) = tcSplitFunTys t_ty
+ id = mkLocalId nm sig_ty
+ in
+ tcCheckFIType sig_ty arg_tys res_ty imp_decl `thenNF_Tc_`
+ returnTc (id, ForeignImport id undefined imp_decl isDeprec src_loc)
+\end{code}
+
+
+------------ Checking types for foreign import ----------------------
+\begin{code}
+tcCheckFIType _ _ _ (DNImport _)
+ = checkCg checkDotNet
+
+tcCheckFIType sig_ty arg_tys res_ty (CImport _ _ _ _ (CLabel _))
+ = checkCg checkCOrAsm `thenNF_Tc_`
+ check (isFFILabelTy sig_ty) (illegalForeignTyErr empty sig_ty)
+
+tcCheckFIType sig_ty arg_tys res_ty (CImport _ _ _ _ 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 checkCOrAsm `thenNF_Tc_`
+ case arg_tys of
+ [arg1_ty] -> checkForeignArgs isFFIExternalTy arg1_tys `thenNF_Tc_`
+ checkForeignRes nonIOok isFFIExportResultTy res1_ty `thenNF_Tc_`
+ checkForeignRes mustBeIO isFFIDynResultTy res_ty `thenNF_Tc_`
+ checkFEDArgs arg1_tys
+ where
+ (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
+ other -> addErrTc (illegalForeignTyErr empty sig_ty)
+
+tcCheckFIType sig_ty arg_tys res_ty (CImport _ safety _ _ (CFunction target))
+ | isDynamicTarget target -- Foreign import dynamic
+ = checkCg checkCOrAsmOrInterp `thenNF_Tc_`
+ case arg_tys of -- The first arg must be Ptr, FunPtr, or Addr
+ [] -> check False (illegalForeignTyErr empty sig_ty)
+ (arg1_ty:arg_tys) -> getDOptsTc `thenNF_Tc` \ dflags ->
+ check (isFFIDynArgumentTy arg1_ty)
+ (illegalForeignTyErr argument arg1_ty) `thenNF_Tc_`
+ checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys `thenNF_Tc_`
+ checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty