+tcFImport :: RenamedForeignDecl -> TcM (Id, TypecheckedForeignDecl)
+tcFImport fo@(ForeignImport nm hs_ty imp_decl 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 src_loc)
+\end{code}
+
+
+------------ Checking types for foreign import ----------------------
+\begin{code}
+tcCheckFIType _ _ _ (DNImport _)
+ = checkCg checkDotNet
+
+tcCheckFIType sig_ty arg_tys res_ty (LblImport _)
+ = checkCg checkCOrAsm `thenNF_Tc_`
+ check (isFFILabelTy sig_ty) (illegalForeignTyErr empty sig_ty)
+
+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 `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 (CCallSpec target _ safety))
+ | isDynamicTarget target -- Foreign import dynamic
+ = checkCg checkCOrAsmOrInterp `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 checkCOrAsmOrDotNetOrInterp) `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 checkCOrAsmOrDotNetOrInterp `thenNF_Tc_`
+ check (isCLabelString str) (badCName str)
+
+checkCTarget (CasmTarget _)
+ = checkCg checkC
+\end{code}
+
+On a SPARC, with foreign export dynamic, due to a giant hack when building
+adjustor thunks, we only allow 16 bytes of arguments!
+
+So for example, args (Int,Double,Int) would be OK (1+2+1)
+as would (Int,Int,Int,Int) (1+1+1+1) but not (Int,Double,Double) (1+2+2).
+
+On an Alpha, due to a similar hack, we only allow 4 integer arguments with
+foreign export dynamic (i.e., 32 bytes of arguments after padding each
+argument to a quadword, excluding floating-point arguments).
+
+The check is needed for both via-C and native-code routes
+
+\begin{code}
+#include "nativeGen/NCG.h"
+#if sparc_TARGET_ARCH
+checkFEDArgs arg_tys
+ = check (words_of_args <= 4) err
+ where
+ words_of_args = sum (map (getPrimRepSize . typePrimRep) arg_tys)
+ err = ptext SLIT("On SPARC, I can only handle 4 words of arguments to foreign export dynamic")
+#else
+#if alpha_TARGET_ARCH
+checkFEDArgs arg_tys
+ = check (integral_args <= 4) err
+ where
+ integral_args = sum (map getPrimRepSize $
+ filter (not . isFloatingRep) $
+ map typePrimRep arg_tys)
+ err = ptext SLIT("On Alpha, I can only handle 4 non-floating-point arguments to foreign export dynamic")
+#else
+checkFEDArgs arg_tys = returnNF_Tc ()
+#endif
+#endif
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Exports}
+%* *
+%************************************************************************
+
+\begin{code}