+tcCheckFIType sig_ty arg_tys res_ty (CDynImport _)
+ = -- Foreign export dynamic
+ -- The first (and only!) arg has got to be a function type
+ -- and it must return IO t; result type is IO Addr
+ 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
+ where
+ (arg1_tys, res1_ty) = splitFunTys arg1_ty
+ other -> addErrTc (illegalForeignTyErr empty sig_ty)
+
+tcCheckFIType sig_ty arg_tys res_ty (CImport (CCallSpec target _ safety))
+ | isDynamicTarget target -- Foreign import dynamic
+ = checkCg checkCOrAsm `thenNF_Tc_`
+ case arg_tys of -- The first arg must be 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
+
+ | otherwise -- Normal foreign import
+ = checkCg (if isCasmTarget target
+ then checkC else checkCOrAsmOrDotNet) `thenNF_Tc_`
+ checkCTarget target `thenNF_Tc_`
+ getDOptsTc `thenNF_Tc` \ dflags ->
+ checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys `thenNF_Tc_`
+ checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty
+
+-- This makes a convenient place to check
+-- that the C identifier is valid for C
+checkCTarget (StaticTarget str)
+ = checkCg checkCOrAsmOrDotNet `thenNF_Tc_`
+ check (isCLabelString str) (badCName str)
+
+checkCTarget (CasmTarget _)
+ = checkCg checkC
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Exports}
+%* *
+%************************************************************************
+
+\begin{code}
+tcForeignExports :: [RenamedHsDecl] -> TcM (LIE, TcMonoBinds, [TcForeignExportDecl])
+tcForeignExports decls =
+ foldlTc combine (emptyLIE, EmptyMonoBinds, [])
+ [ foreign_decl | ForD foreign_decl <- decls, isForeignExport foreign_decl]
+ where
+ combine (lie, binds, fs) fe =
+ tcFExport fe `thenTc ` \ (a_lie, b, f) ->
+ returnTc (lie `plusLIE` a_lie, b `AndMonoBinds` binds, f:fs)
+
+tcFExport :: RenamedForeignDecl -> TcM (LIE, TcMonoBinds, TcForeignExportDecl)
+tcFExport fo@(ForeignExport nm hs_ty spec src_loc) =
+ tcAddSrcLoc src_loc $
+ tcAddErrCtxt (foreignDeclCtxt fo) $
+
+ tcHsLiftedSigType hs_ty `thenTc` \ sig_ty ->
+ tcPolyExpr (HsVar nm) sig_ty `thenTc` \ (rhs, lie, _, _, _) ->
+
+ tcCheckFEType sig_ty spec `thenTc_`