X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcForeign.lhs;h=49ecffc357e74e17ed90d8397ff3015e61142710;hb=5822cb8d13aa3c05d2b46b4510c13d94b902eb21;hp=705a3c32f51b2ba5f388362dc215f842c0a4bc35;hpb=ab22f4e6456820c1b5169d75f5975a94e61f54ce;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index 705a3c3..49ecffc 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -34,10 +34,8 @@ import Type import SMRep import MachOp #endif -import OccName import Name import TcType -import ForeignCall import DynFlags import Outputable import SrcLoc @@ -216,8 +214,7 @@ tcFExport fo@(ForeignExport (L loc nm) hs_ty spec) = newUnique `thenM` \ uniq -> getModule `thenM` \ mod -> let - gnm = mkExternalName uniq mod (mkForeignExportOcc (getOccName nm)) - (srcSpanStart loc) + gnm = mkExternalName uniq mod (mkForeignExportOcc (getOccName nm)) loc id = mkExportedLocalId gnm sig_ty bind = L loc (VarBind id rhs) in @@ -266,7 +263,7 @@ mustBeIO = False checkForeignRes non_io_result_ok pred_res_ty ty -- (IO t) is ok, and so is any newtype wrapping thereof - | Just (io, res_ty) <- tcSplitIOType_maybe ty, + | Just (io, res_ty, _) <- tcSplitIOType_maybe ty, pred_res_ty res_ty = returnM () @@ -309,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