X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsForeign.lhs;h=5d47921c7e78b02a1be756c02f630901a14c89ac;hp=e5cbbfbe51ee2c7c759ed5aae5b9962893f750df;hb=16513d4899e167d20e120c2b3907230b7ff9dd83;hpb=ceaa116940587d4ea2e2104e3c3313002d852659 diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index e5cbbfb..5d47921 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -28,7 +28,7 @@ import SMRep ( argMachRep, typeCgRep ) import CoreUtils ( exprType, mkInlineMe ) import Id ( Id, idType, idName, mkSysLocal, setInlinePragma ) import Literal ( Literal(..), mkStringLit ) -import Module ( moduleFS ) +import Module ( moduleNameFS, moduleName ) import Name ( getOccString, NamedThing(..) ) import Type ( repType, coreEqType ) import TcType ( Type, mkFunTys, mkForAllTys, mkTyConApp, @@ -83,10 +83,9 @@ dsForeigns fos combine stubs (L loc decl) = putSrcSpanDs loc (combine1 stubs decl) combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) - (ForeignImport id _ spec depr) + (ForeignImport id _ spec) = traceIf (text "fi start" <+> ppr id) `thenDs` \ _ -> dsFImport (unLoc id) spec `thenDs` \ (bs, h, c, mbhd) -> - warnDepr depr `thenDs` \ _ -> traceIf (text "fi end" <+> ppr id) `thenDs` \ _ -> returnDs (ForeignStubs (h $$ acc_h) (c $$ acc_c) @@ -95,10 +94,9 @@ dsForeigns fos bs ++ acc_f) combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) - (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv)) depr) + (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv))) = dsFExport id (idType id) ext_nm cconv False `thenDs` \(h, c, _, _) -> - warnDepr depr `thenDs` \_ -> returnDs (ForeignStubs (h $$ acc_h) (c $$ acc_c) acc_hdrs (id:acc_feb), acc_f) @@ -106,11 +104,6 @@ dsForeigns fos addH (Just e) ls | e `elem` ls = ls | otherwise = e:ls - - warnDepr False = returnDs () - warnDepr True = dsWarn msg - where - msg = ptext SLIT("foreign declaration uses deprecated non-standard syntax") \end{code} @@ -351,10 +344,10 @@ dsFExportDynamic :: Id -> DsM ([Binding], SDoc, SDoc) dsFExportDynamic id cconv = newSysLocalDs ty `thenDs` \ fe_id -> - getModuleDs `thenDs` \ mod_name -> + getModuleDs `thenDs` \ mod -> let -- hack: need to get at the name of the C stub we're about to generate. - fe_nm = mkFastString (unpackFS (zEncodeFS (moduleFS mod_name)) ++ "_" ++ toCName fe_id) + fe_nm = mkFastString (unpackFS (zEncodeFS (moduleNameFS (moduleName mod))) ++ "_" ++ toCName fe_id) in newSysLocalDs arg_ty `thenDs` \ cback -> dsLookupGlobalId newStablePtrName `thenDs` \ newStablePtrId ->