-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_`
+tcCheckFIType _ arg_tys res_ty (DNImport spec)
+ = checkCg checkDotnet `thenM_`
+ getDOpts `thenM` \ dflags ->
+ checkForeignArgs (isFFIDotnetTy dflags) arg_tys `thenM_`
+ checkForeignRes True{-non IO ok-} (isFFIDotnetTy dflags) res_ty `thenM_`
+ let (DNCallSpec isStatic kind _ _ _ _) = spec in
+ (case kind of
+ DNMethod | not isStatic ->
+ case arg_tys of
+ [] -> addErrTc illegalDNMethodSig
+ _
+ | not (isFFIDotnetObjTy (last arg_tys)) -> addErrTc illegalDNMethodSig
+ | otherwise -> returnM ()
+ _ -> returnM ()) `thenM_`
+ returnM (DNImport (withDNTypes spec (map toDNType arg_tys) (toDNType res_ty)))
+
+tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ _ (CLabel _))
+ = checkCg checkCOrAsm `thenM_`
+ check (isFFILabelTy sig_ty) (illegalForeignTyErr empty sig_ty) `thenM_`
+ return idecl
+
+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_`
+ (case arg_tys of
+ [arg1_ty] -> checkForeignArgs isFFIExternalTy arg1_tys `thenM_`
+ checkForeignRes nonIOok isFFIExportResultTy res1_ty `thenM_`
+ checkForeignRes mustBeIO isFFIDynResultTy res_ty `thenM_`