X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcForeign.lhs;h=4019feb8e627c718980846155a23e0dcac83ae24;hb=b00b5bc04ff36a551552470060064f0b7d84ca30;hp=fc98fdb35a13ebc1f3b2bc35f1e1903c6c92d264;hpb=fb0f3349561dd4493d81ca7c3a140b37fa0dc0de;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index fc98fdb..4019feb 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -34,7 +34,7 @@ import SMRep ( argMachRep, primRepToCgRep, primRepHint ) #endif import OccName ( mkForeignExportOcc ) import Name ( Name, NamedThing(..), mkExternalName ) -import TcType ( Type, tcSplitFunTys, tcSplitTyConApp_maybe, +import TcType ( Type, tcSplitFunTys, tcSplitForAllTys, tcSplitIOType_maybe, isFFIArgumentTy, isFFIImportResultTy, isFFIExportResultTy, isFFILabelTy, @@ -45,7 +45,6 @@ import TcType ( Type, tcSplitFunTys, tcSplitTyConApp_maybe, import ForeignCall ( CExportSpec(..), CCallTarget(..), CLabelString, isCLabelString, isDynamicTarget, withDNTypes, DNKind(..), DNCallSpec(..) ) -import PrelNames ( hasKey, ioTyConKey ) import DynFlags ( DynFlags(..), HscTarget(..) ) import Outputable import SrcLoc ( Located(..), srcSpanStart ) @@ -59,12 +58,12 @@ import MachOp ( machRepByteWidth, MachHint(FloatHint) ) \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 +79,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 +95,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 +211,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 -> @@ -229,11 +228,11 @@ tcFExport fo@(ForeignExport (L loc nm) hs_ty spec isDeprec) = getModule `thenM` \ mod -> let gnm = mkExternalName uniq mod (mkForeignExportOcc (getOccName nm)) - Nothing (srcSpanStart loc) + (srcSpanStart 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 +287,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 +307,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 ->