X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=df1925d94503a0c237a661f0ad6280ed9ffbfe28;hb=4d9d0308c951ace938b5a209a8b046260739b3f1;hp=683dfd88c974c80e415b1bb07a66be62b3600be0;hpb=7d7d186e02f0c86efb7fc9291a142b30005718ae;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 683dfd8..df1925d 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -14,26 +14,27 @@ import CmdLineOpts ( DynFlag(..) ) import HsSyn ( HsModule(..), HsDecl(..), IE(..), ieName, ImportDecl(..), ForeignDecl(..), ForKind(..), isDynamicExtName, - collectTopBinders + collectLocatedHsBinders ) import RdrHsSyn ( RdrNameIE, RdrNameImportDecl, RdrNameHsModule, RdrNameHsDecl ) -import RnIfaces ( getInterfaceExports, recordLocalSlurps ) -import RnHiFiles ( getTyClDeclBinders ) +import RnIfaces ( recordLocalSlurps ) +import RnHiFiles ( getTyClDeclBinders, loadInterface ) import RnEnv import RnMonad import FiniteMap import PrelNames ( pRELUDE_Name, mAIN_Name, main_RDR_Unqual, isUnboundName ) import UniqFM ( lookupUFM ) -import Bag ( bagToList ) import Module ( ModuleName, moduleName, WhereFrom(..) ) import NameSet import Name ( Name, nameSrcLoc, nameOccName, nameEnvElts ) import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv, - GenAvailInfo(..), AvailInfo, Avails, AvailEnv ) -import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc ) + GenAvailInfo(..), AvailInfo, Avails, AvailEnv, + Deprecations(..), ModIface(..) + ) +import RdrName ( rdrNameOcc, setRdrNameOcc ) import OccName ( setOccNameSpace, dataName ) import NameSet ( elemNameSet, emptyNameSet ) import Outputable @@ -124,15 +125,14 @@ importsFromImportDecl :: ModuleName importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc) = pushSrcLocRn iloc $ - getInterfaceExports imp_mod_name from `thenRn` \ (imp_mod, avails_by_module) -> - - if null avails_by_module then - -- If there's an error in getInterfaceExports, (e.g. interface - -- file not found) we get lots of spurious errors from 'filterImports' - returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name) - else + loadInterface (ppr imp_mod_name <+> ptext SLIT("is directly imported")) + imp_mod_name from `thenRn` \ iface -> let + imp_mod = mi_module iface + avails_by_module = mi_exports iface + deprecs = mi_deprecs iface + avails :: Avails avails = [ avail | (mod_name, avails) <- avails_by_module, mod_name /= this_mod_name, @@ -155,6 +155,19 @@ importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_m -- then you'll get a 'B does not export AType' message. Oh well. in + if null avails_by_module then + -- If there's an error in loadInterface, (e.g. interface + -- file not found) we get lots of spurious errors from 'filterImports' + returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name) + else + + -- Complain if we import a deprecated module + (case deprecs of + DeprecAll txt -> addWarnRn (moduleDeprec imp_mod_name txt) + other -> returnRn () + ) `thenRn_` + + -- Filter the imports according to the import list filterImports imp_mod_name from import_spec avails `thenRn` \ (filtered_avails, hides, explicits) -> let @@ -164,8 +177,8 @@ importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_m Just another_name -> another_name mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits)) - gbl_env = mkGlobalRdrEnv qual_mod unqual_imp hides mk_prov filtered_avails - exports = mkExportAvails qual_mod unqual_imp gbl_env filtered_avails + gbl_env = mkGlobalRdrEnv qual_mod unqual_imp True hides mk_prov filtered_avails deprecs + exports = mkExportAvails qual_mod unqual_imp gbl_env filtered_avails in returnRn (gbl_env, exports) \end{code} @@ -174,7 +187,7 @@ importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_m \begin{code} importsFromLocalDecls this_mod decls = mapRn (getLocalDeclBinders this_mod) decls `thenRn` \ avails_s -> - + -- The avails that are returned don't include the "system" names let avails = concat avails_s @@ -185,34 +198,48 @@ importsFromLocalDecls this_mod decls (_, dups) = removeDups compare all_names in -- Check for duplicate definitions + -- The complaint will come out as "Multiple declarations of Foo.f" because + -- since 'f' is in the env twice, the unQualInScope used by the error-msg + -- printer returns False. It seems awkward to fix, unfortunately. mapRn_ (addErrRn . dupDeclErr) dups `thenRn_` + -- Record that locally-defined things are available recordLocalSlurps (availsToNameSet avails) `thenRn_` - let mod_name = moduleName this_mod unqual_imp = True -- Want unqualified names mk_prov n = LocalDef -- Provenance is local hides = [] -- Hide nothing - gbl_env = mkGlobalRdrEnv mod_name unqual_imp [] mk_prov avails - exports = mkExportAvails mod_name unqual_imp gbl_env avails + + gbl_env = mkGlobalRdrEnv mod_name unqual_imp True hides mk_prov avails NoDeprecs + -- NoDeprecs: don't complain about locally defined names + -- For a start, we may be exporting a deprecated thing + -- Also we may use a deprecated thing in the defn of another + -- deprecated things. We may even use a deprecated thing in + -- the defn of a non-deprecated thing, when changing a module's + -- interface + + exports = mkExportAvails mod_name unqual_imp gbl_env avails in returnRn (gbl_env, exports) --------------------------- -getLocalDeclBinders :: Module - -> RdrNameHsDecl -> RnMG Avails +getLocalDeclBinders :: Module -> RdrNameHsDecl -> RnMG [AvailInfo] getLocalDeclBinders mod (TyClD tycl_decl) = -- For type and class decls, we generate Global names, with -- no export indicator. They need to be global because they get -- permanently bound into the TyCons and Classes. They don't need -- an export indicator because they are all implicitly exported. - getTyClDeclBinders mod tycl_decl `thenRn` \ avail -> + getTyClDeclBinders mod tycl_decl `thenRn` \ (avail, sys_names) -> + + -- Record that the system names are available + recordLocalSlurps (mkNameSet sys_names) `thenRn_` returnRn [avail] getLocalDeclBinders mod (ValD binds) - = mapRn new (bagToList (collectTopBinders binds)) + = mapRn new (collectLocatedHsBinders binds) `thenRn` \ avails -> + returnRn avails where new (rdr_name, loc) = newTopBinder mod rdr_name loc `thenRn` \ name -> returnRn (Avail name) @@ -565,4 +592,8 @@ dupModuleExport mod = hsep [ptext SLIT("Duplicate"), quotes (ptext SLIT("Module") <+> ppr mod), ptext SLIT("in export list")] + +moduleDeprec mod txt + = sep [ ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is deprecated:"), + nest 4 (ppr txt) ] \end{code}