X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=9e2b7778a17cf3bc820df43e0b4406700e7614dd;hb=1c62b517711ac232a8024d91fd4b317a6804d28e;hp=79cc35cd19b6843815dbad96c456d186e4ef36fe;hpb=424b70f24577085ebc813351b7b774ea8c02c789;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 79cc35c..9e2b777 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -14,13 +14,13 @@ 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 @@ -32,8 +32,10 @@ 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, mkRdrQual, mkRdrUnqual ) + GenAvailInfo(..), AvailInfo, Avails, AvailEnv, + Deprecations(..), ModIface(..) + ) +import RdrName ( rdrNameOcc, setRdrNameOcc ) import OccName ( setOccNameSpace, dataName ) import NameSet ( elemNameSet, emptyNameSet ) import Outputable @@ -124,15 +126,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,24 +156,39 @@ 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 - mk_provenance name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits)) + unqual_imp = not qual_only -- Maybe want unqualified names + qual_mod = case as_mod of + Nothing -> imp_mod_name + Just another_name -> another_name + + mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits)) + 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 - - qualifyImports imp_mod_name - (not qual_only) -- Maybe want unqualified names - as_mod hides - mk_provenance - filtered_avails + returnRn (gbl_env, exports) \end{code} \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,30 +201,43 @@ importsFromLocalDecls this_mod decls -- Check for duplicate definitions mapRn_ (addErrRn . dupDeclErr) dups `thenRn_` + -- Record that locally-defined things are available recordLocalSlurps (availsToNameSet avails) `thenRn_` - - -- Build the environment - qualifyImports (moduleName this_mod) - True -- Want unqualified names - Nothing -- no 'as M' - [] -- Hide nothing - (\n -> LocalDef) -- Provenance is local - avails + 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 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) @@ -337,66 +366,12 @@ filterImports mod from (Just (want_hiding, import_items)) total_avails %* * %************************************************************************ -@qualifyImports@ takes the @ExportEnv@ after filtering through the import spec -of an import decl, and deals with producing an @RnEnv@ with the -right qualified names. It also turns the @Names@ in the @ExportEnv@ into -fully fledged @Names@. - \begin{code} -qualifyImports :: ModuleName -- Imported module - -> Bool -- True <=> want unqualified import - -> Maybe ModuleName -- Optional "as M" part - -> [AvailInfo] -- What's to be hidden (but only the unqualified - -- version is hidden) - -> (Name -> Provenance) - -> Avails -- Whats imported and how - -> RnMG (GlobalRdrEnv, ExportAvails) - -qualifyImports this_mod unqual_imp as_mod hides mk_provenance avails - = - -- Make the name environment. We're talking about a - -- single module here, so there must be no name clashes. - -- In practice there only ever will be if it's the module - -- being compiled. - let - -- Add the things that are available - name_env1 = foldl add_avail emptyRdrEnv avails - - -- Delete things that are hidden - name_env2 = foldl del_avail name_env1 hides - - -- Create the export-availability info - export_avails = mkExportAvails qual_mod unqual_imp name_env2 avails - in - returnRn (name_env2, export_avails) - - where - qual_mod = case as_mod of - Nothing -> this_mod - Just another_name -> another_name - - add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv - add_avail env avail = foldl add_name env (availNames avail) - - add_name env name - | unqual_imp = env2 - | otherwise = env1 - where - env1 = addOneToGlobalRdrEnv env (mkRdrQual qual_mod occ) (name,prov) - env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) (name,prov) - occ = nameOccName name - prov = mk_provenance name - - del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names - where - rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail) - - mkEmptyExportAvails :: ModuleName -> ExportAvails mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM) mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails -mkExportAvails mod_name unqual_imp name_env avails +mkExportAvails mod_name unqual_imp gbl_env avails = (mod_avail_env, entity_avail_env) where mod_avail_env = unitFM mod_name unqual_avails @@ -417,7 +392,7 @@ mkExportAvails mod_name unqual_imp name_env avails where uqs = filter unqual_in_scope ns - unqual_in_scope n = unQualInScope name_env n + unqual_in_scope n = unQualInScope gbl_env n entity_avail_env = listToUFM [ (name,avail) | avail <- avails, name <- availNames avail] @@ -615,4 +590,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}