Store a SrcSpan instead of a SrcLoc inside a Name

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

diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index fc98fdb..a710111 100644 (file)
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -1,4 +1,5 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The AQUA Project, Glasgow University, 1998
 %
 \section[TcForeign]{Typechecking \tr{foreign} declarations}
@@ -22,49 +23,34 @@ module TcForeign
 import HsSyn
 
 import TcRnMonad
-import TcHsType                ( tcHsSigType, UserTypeCtxt(..) )
-import TcExpr          ( tcPolyExpr )                  
+import TcHsType
+import TcExpr
 
-import ForeignCall     ( CCallConv(..) )
-import ErrUtils                ( Message )
-import Id              ( Id, mkLocalId, mkExportedLocalId )
+import ForeignCall
+import ErrUtils
+import Id
 #if alpha_TARGET_ARCH
-import Type            ( typePrimRep )
-import SMRep           ( argMachRep, primRepToCgRep, primRepHint )
+import Type
+import SMRep
+import MachOp
 #endif
-import OccName         ( mkForeignExportOcc )
-import Name            ( Name, NamedThing(..), mkExternalName )
-import TcType          ( Type, tcSplitFunTys, tcSplitTyConApp_maybe,
-                         tcSplitForAllTys, tcSplitIOType_maybe,
-                         isFFIArgumentTy, isFFIImportResultTy, 
-                         isFFIExportResultTy, isFFILabelTy,
-                         isFFIExternalTy, isFFIDynArgumentTy,
-                         isFFIDynResultTy, isFFIDotnetTy, isFFIDotnetObjTy,
-                         toDNType
-                       )
-import ForeignCall     ( CExportSpec(..), CCallTarget(..), 
-                         CLabelString, isCLabelString,
-                         isDynamicTarget, withDNTypes, DNKind(..), DNCallSpec(..) ) 
-import PrelNames       ( hasKey, ioTyConKey )
-import DynFlags                ( DynFlags(..), HscTarget(..) )
+import Name
+import TcType
+import DynFlags
 import Outputable
-import SrcLoc          ( Located(..), srcSpanStart )
-import Bag             ( consBag )
-
-#if alpha_TARGET_ARCH
-import MachOp          ( machRepByteWidth, MachHint(FloatHint) )
-#endif
+import SrcLoc
+import Bag
 \end{code}
 
 \begin{code}
 -- Defines a binding
 isForeignImport :: LForeignDecl name -> Bool
-isForeignImport (L _ (ForeignImport _ _ _ _)) = True
+isForeignImport (L _ (ForeignImport _ _ _)) = True
 isForeignImport _                            = False
 
 -- Exports a binding
 isForeignExport :: LForeignDecl name -> Bool
-isForeignExport (L _ (ForeignExport _ _ _ _)) = True
+isForeignExport (L _ (ForeignExport _ _ _)) = True
 isForeignExport _                            = False
 \end{code}
 
@@ -80,7 +66,7 @@ tcForeignImports decls
   = mapAndUnzipM (wrapLocSndM tcFImport) (filter isForeignImport decls)
 
 tcFImport :: ForeignDecl Name -> TcM (Id, ForeignDecl Id)
-tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl isDeprec)
+tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl)
  = addErrCtxt (foreignDeclCtxt fo)     $
    tcHsSigType (ForSigCtxt nm) hs_ty   `thenM` \ sig_ty ->
    let 
@@ -96,7 +82,7 @@ tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl isDeprec)
    tcCheckFIType sig_ty arg_tys res_ty imp_decl                `thenM` \ imp_decl' -> 
    -- can't use sig_ty here because it :: Type and we need HsType Id
    -- hence the undefined
-   returnM (id, ForeignImport (L loc id) undefined imp_decl' isDeprec)
+   returnM (id, ForeignImport (L loc id) undefined imp_decl')
 \end{code}
 
 
@@ -212,7 +198,7 @@ tcForeignExports decls
        returnM (b `consBag` binds, f:fs)
 
 tcFExport :: ForeignDecl Name -> TcM (LHsBind Id, ForeignDecl Id)
-tcFExport fo@(ForeignExport (L loc nm) hs_ty spec isDeprec) =
+tcFExport fo@(ForeignExport (L loc nm) hs_ty spec) =
    addErrCtxt (foreignDeclCtxt fo)     $
 
    tcHsSigType (ForSigCtxt nm) hs_ty   `thenM` \ sig_ty ->
@@ -228,12 +214,11 @@ tcFExport fo@(ForeignExport (L loc nm) hs_ty spec isDeprec) =
    newUnique                   `thenM` \ uniq ->
    getModule                   `thenM` \ mod ->
    let
-        gnm  = mkExternalName uniq mod (mkForeignExportOcc (getOccName nm)) 
-                             Nothing (srcSpanStart loc)
+        gnm  = mkExternalName uniq mod (mkForeignExportOcc (getOccName nm)) loc
        id   = mkExportedLocalId gnm sig_ty
        bind = L loc (VarBind id rhs)
    in
-   returnM (bind, ForeignExport (L loc id) undefined spec isDeprec)
+   returnM (bind, ForeignExport (L loc id) undefined spec)
 \end{code}
 
 ------------ Checking argument types for foreign export ----------------------
@@ -288,7 +273,6 @@ checkForeignRes non_io_result_ok pred_res_ty ty
 \end{code}
 
 \begin{code}
-checkDotnet HscILX = Nothing
 #if defined(mingw32_TARGET_OS)
 checkDotnet HscC   = Nothing
 checkDotnet _      = Just (text "requires C code generation (-fvia-C)")
@@ -309,10 +293,9 @@ checkCOrAsmOrInterp other
 
 checkCOrAsmOrDotNetOrInterp HscC           = Nothing
 checkCOrAsmOrDotNetOrInterp HscAsm         = Nothing
-checkCOrAsmOrDotNetOrInterp HscILX         = Nothing
 checkCOrAsmOrDotNetOrInterp HscInterpreted = Nothing
 checkCOrAsmOrDotNetOrInterp other  
-   = Just (text "requires interpreted, C, native or .NET ILX code generation")
+   = Just (text "requires interpreted, C or native code generation")
 
 checkCg check
  = getDOpts            `thenM` \ dflags ->
@@ -323,7 +306,7 @@ checkCg check
        case check target of
         Nothing  -> returnM ()
         Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
-\end{code} 
+\end{code}
                           
 Calling conventions