[project @ 2003-04-10 15:46:11 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcForeign.lhs

diff --git a/ghc/compiler/typecheck/TcForeign.lhs b/ghc/compiler/typecheck/TcForeign.lhs
index dadf8be..bcf44f1 100644 (file)
--- a/ghc/compiler/typecheck/TcForeign.lhs
+++ b/ghc/compiler/typecheck/TcForeign.lhs
@@ -19,11 +19,11 @@ module TcForeign
 
 #include "HsVersions.h"
 
-import HsSyn           ( HsDecl(..), ForeignDecl(..), HsExpr(..),
+import HsSyn           ( ForeignDecl(..), HsExpr(..),
                          MonoBinds(..), ForeignImport(..), ForeignExport(..),
                          CImportSpec(..)
                        )
-import RnHsSyn         ( RenamedHsDecl, RenamedForeignDecl )
+import RnHsSyn         ( RenamedForeignDecl )
 
 import TcRnMonad
 import TcMonoType      ( tcHsSigType, UserTypeCtxt(..) )
@@ -36,7 +36,7 @@ import IdInfo         ( noCafIdInfo )
 import PrimRep         ( getPrimRepSize, isFloatingRep )
 import Type            ( typePrimRep )
 import OccName         ( mkForeignExportOcc )
-import Name            ( NamedThing(..), mkExternalName )
+import Name            ( Name, NamedThing(..), mkExternalName )
 import TcType          ( Type, tcSplitFunTys, tcSplitTyConApp_maybe,
                          tcSplitForAllTys, 
                          isFFIArgumentTy, isFFIImportResultTy, 
@@ -72,10 +72,9 @@ isForeignExport _                      = False
 %************************************************************************
 
 \begin{code}
-tcForeignImports :: [RenamedHsDecl] -> TcM ([Id], [TypecheckedForeignDecl])
-tcForeignImports decls = 
-  mapAndUnzipM tcFImport 
-    [ foreign_decl | ForD foreign_decl <- decls, isForeignImport foreign_decl]
+tcForeignImports :: [ForeignDecl Name] -> TcM ([Id], [TypecheckedForeignDecl])
+tcForeignImports decls
+  = mapAndUnzipM tcFImport (filter isForeignImport decls)
 
 tcFImport :: RenamedForeignDecl -> TcM (Id, TypecheckedForeignDecl)
 tcFImport fo@(ForeignImport nm hs_ty imp_decl isDeprec src_loc)
@@ -114,14 +113,7 @@ tcCheckFIType sig_ty arg_tys res_ty (CImport cconv _ _ _ CWrapper)
        -- 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 (if cconv == StdCallConv
-               then checkC
-               else checkCOrAsmOrInterp)               `thenM_`
-       -- the native code gen can't handle foreign import stdcall "wrapper",
-       -- because it doesn't emit the '@n' suffix on the label of the
-       -- C stub function.  Infrastructure changes are required to make this
-       -- happen; MachLabel will need to carry around information about
-       -- the arity of the foreign call.
+    checkCg checkCOrAsmOrInterp `thenM_`
     case arg_tys of
        [arg1_ty] -> checkForeignArgs isFFIExternalTy arg1_tys                  `thenM_`
                     checkForeignRes nonIOok  isFFIExportResultTy res1_ty       `thenM_`
@@ -190,11 +182,10 @@ checkFEDArgs arg_tys = returnM ()
 %************************************************************************
 
 \begin{code}
-tcForeignExports :: [RenamedHsDecl] 
+tcForeignExports :: [ForeignDecl Name] 
                 -> TcM (TcMonoBinds, [TcForeignDecl])
-tcForeignExports decls = 
-   foldlM combine (EmptyMonoBinds, [])
-     [foreign_decl | ForD foreign_decl <- decls, isForeignExport foreign_decl]
+tcForeignExports decls
+  = foldlM combine (EmptyMonoBinds, []) (filter isForeignExport decls)
   where
    combine (binds, fs) fe = 
        tcFExport fe    `thenM ` \ (b, f) ->