[project @ 2003-11-03 16:00:57 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 ec2cffe..3b880c0 100644 (file)
--- a/ghc/compiler/typecheck/TcForeign.lhs
+++ b/ghc/compiler/typecheck/TcForeign.lhs
@@ -27,13 +27,12 @@ import HsSyn                ( ForeignDecl(..), HsExpr(..),
 import RnHsSyn         ( RenamedForeignDecl )
 
 import TcRnMonad
-import TcMonoType      ( tcHsSigType, UserTypeCtxt(..) )
+import TcHsType                ( tcHsSigType, UserTypeCtxt(..) )
 import TcHsSyn         ( TcMonoBinds, TypecheckedForeignDecl, TcForeignDecl )
 import TcExpr          ( tcCheckSigma )                        
 
 import ErrUtils                ( Message )
-import Id              ( Id, mkLocalId, mkVanillaGlobal, setIdLocalExported )
-import IdInfo          ( noCafIdInfo )
+import Id              ( Id, mkLocalId, setIdLocalExported )
 import PrimRep         ( getPrimRepSize, isFloatingRep )
 import Type            ( typePrimRep )
 import OccName         ( mkForeignExportOcc )
@@ -46,8 +45,8 @@ import TcType         ( Type, tcSplitFunTys, tcSplitTyConApp_maybe,
                          isFFIDynResultTy, isFFIDotnetTy, isFFIDotnetObjTy,
                          toDNType
                        )
-import ForeignCall     ( CExportSpec(..), CCallTarget(..), CCallConv(..),
-                         isDynamicTarget, isCasmTarget, withDNTypes, DNKind(..), DNCallSpec(..) ) 
+import ForeignCall     ( CExportSpec(..), CCallTarget(..), 
+                         isDynamicTarget, withDNTypes, DNKind(..), DNCallSpec(..) ) 
 import CStrings                ( CLabelString, isCLabelString )
 import PrelNames       ( hasKey, ioTyConKey )
 import CmdLineOpts     ( dopt_HscLang, HscLang(..) )
@@ -155,8 +154,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ _ (CFunction targe
        checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty  `thenM_`
        return idecl
   | otherwise          -- Normal foreign import
-  = checkCg (if isCasmTarget target
-            then checkC else checkCOrAsmOrDotNetOrInterp)      `thenM_`
+  = checkCg (checkCOrAsmOrDotNetOrInterp)                      `thenM_`
     checkCTarget target                                                `thenM_`
     getDOpts                                                   `thenM` \ dflags ->
     checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys   `thenM_`
@@ -168,9 +166,6 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ _ (CFunction targe
 checkCTarget (StaticTarget str) 
   = checkCg checkCOrAsmOrDotNetOrInterp                `thenM_`
     check (isCLabelString str) (badCName str)
-
-checkCTarget (CasmTarget _)
-  = checkCg checkC
 \end{code}
 
 On an Alpha, with foreign export dynamic, due to a giant hack when
@@ -230,7 +225,8 @@ tcFExport fo@(ForeignExport nm hs_ty spec isDeprec src_loc) =
    newUnique                   `thenM` \ uniq ->
    getModule                   `thenM` \ mod ->
    let
-        gnm  = mkExternalName uniq mod (mkForeignExportOcc (getOccName nm)) src_loc
+        gnm  = mkExternalName uniq mod (mkForeignExportOcc (getOccName nm)) 
+                             Nothing src_loc
        id   = setIdLocalExported (mkLocalId gnm sig_ty)
        bind = VarMonoBind id rhs
    in
@@ -296,9 +292,6 @@ checkDotnet _      = Just (text "requires C code generation (-fvia-C)")
 checkDotnet other  = Just (text "requires .NET support (-filx or win32)")
 #endif
 
-checkC HscC  = Nothing
-checkC other = Just (text "requires C code generation (-fvia-C)")
-                          
 checkCOrAsm HscC   = Nothing
 checkCOrAsm HscAsm = Nothing
 checkCOrAsm other  
@@ -310,12 +303,6 @@ checkCOrAsmOrInterp HscInterpreted = Nothing
 checkCOrAsmOrInterp other  
    = Just (text "requires interpreted, C or native code generation")
 
-checkCOrAsmOrDotNet HscC   = Nothing
-checkCOrAsmOrDotNet HscAsm = Nothing
-checkCOrAsmOrDotNet HscILX = Nothing
-checkCOrAsmOrDotNet other  
-   = Just (text "requires C, native or .NET ILX code generation")
-
 checkCOrAsmOrDotNetOrInterp HscC           = Nothing
 checkCOrAsmOrDotNetOrInterp HscAsm         = Nothing
 checkCOrAsmOrDotNetOrInterp HscILX         = Nothing