From: simonpj Date: Tue, 21 Nov 2000 13:13:25 +0000 (+0000) Subject: [project @ 2000-11-21 13:13:25 by simonpj] X-Git-Tag: Approximately_9120_patches~3285 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=7d7d186e02f0c86efb7fc9291a142b30005718ae;p=ghc-hetmet.git [project @ 2000-11-21 13:13:25 by simonpj] In the ModIface for an interface from a .hi file, generate an environment --- diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 23d53a6..67195e2 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -28,7 +28,7 @@ import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps, ) import RnHiFiles ( readIface, removeContext, loadInterface, loadExports, loadFixDecls, loadDeprecs ) -import RnEnv ( availsToNameSet, availName, +import RnEnv ( availsToNameSet, availName, mkIfaceGlobalRdrEnv, emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails, warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules, lookupOrigNames, lookupSrcName, newGlobalName, unQualInScope @@ -486,7 +486,7 @@ loadOldIface parsed_iface mi_boot = False, mi_orphan = pi_orphan iface, mi_fixities = fix_env, mi_deprecs = deprec_env, mi_decls = decls, - mi_globals = panic "No mi_globals in old interface" + mi_globals = mkIfaceGlobalRdrEnv avails } in returnRn mod_iface diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index f7e34dd..e4621a0 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -11,7 +11,7 @@ module RnEnv where -- Export everything import HsSyn import RdrHsSyn ( RdrNameIE ) import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig, - mkRdrUnqual, mkRdrUnqual, qualifyRdrName, lookupRdrEnv, foldRdrEnv + mkRdrUnqual, mkRdrQual, qualifyRdrName, lookupRdrEnv, foldRdrEnv ) import HsTypes ( hsTyVarName, replaceTyVarName ) import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv, @@ -486,6 +486,56 @@ checkDupNames doc_str rdr_names_w_loc %************************************************************************ \begin{code} +mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change) + -> Bool -- True <=> want unqualified import + -> [AvailInfo] -- What's to be hidden (but only the unqualified + -- version is hidden) + -> (Name -> Provenance) + -> Avails -- Whats imported and how + -> GlobalRdrEnv + +mkGlobalRdrEnv this_mod unqual_imp hides mk_provenance avails + = gbl_env2 + where + -- 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. + + -- Add the things that are available + gbl_env1 = foldl add_avail emptyRdrEnv avails + + -- Delete things that are hidden + gbl_env2 = foldl del_avail gbl_env1 hides + + 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 this_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) + +mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv +-- Used to construct a GlobalRdrEnv for an interface that we've +-- read from a .hi file. We can't construct the original top-level +-- environment because we don't have enough info, but we compromise +-- by making an environment from its exports +mkIfaceGlobalRdrEnv m_avails + = foldl add emptyRdrEnv m_avails + where + add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True [] (\n -> LocalDef) avails) +\end{code} + +\begin{code} plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2 diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index 29a6449..84403d7 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -209,7 +209,7 @@ tryLoadInterface doc_str mod_name from mi_fixities = fix_env, mi_deprecs = deprec_env, mi_usages = [], -- Will be filled in later mi_decls = panic "No mi_decls in PIT", - mi_globals = panic "No mi_globals in PIT" + mi_globals = mkIfaceGlobalRdrEnv avails } new_ifaces = ifaces { iPIT = new_pit, diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 79cc35c..683dfd8 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -33,7 +33,7 @@ import NameSet import Name ( Name, nameSrcLoc, nameOccName, nameEnvElts ) import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv, GenAvailInfo(..), AvailInfo, Avails, AvailEnv ) -import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual ) +import RdrName ( RdrName, rdrNameOcc, setRdrNameOcc ) import OccName ( setOccNameSpace, dataName ) import NameSet ( elemNameSet, emptyNameSet ) import Outputable @@ -158,14 +158,16 @@ importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_m 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 hides mk_prov filtered_avails + 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} @@ -188,13 +190,15 @@ importsFromLocalDecls this_mod decls -- 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 [] mk_prov avails + exports = mkExportAvails mod_name unqual_imp gbl_env avails + in + returnRn (gbl_env, exports) --------------------------- getLocalDeclBinders :: Module @@ -337,66 +341,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 +367,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]