From: simonmar Date: Wed, 20 Dec 2000 10:38:18 +0000 (+0000) Subject: [project @ 2000-12-20 10:38:18 by simonmar] X-Git-Tag: Approximately_9120_patches~3034 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=864ce5bdfa24cf352c466d6de8e9f938302d4253;p=ghc-hetmet.git [project @ 2000-12-20 10:38:18 by simonmar] Simon's renamer fixes from yesterday. --- diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index a20ad02..6b96122 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -515,9 +515,10 @@ initPersistentRenamerState :: IO PersistentRenamerState PRS { prsOrig = NameSupply { nsUniqs = us, nsNames = initOrigNames, nsIPs = emptyFM }, - prsDecls = (emptyNameEnv, 0), - prsInsts = (emptyBag, 0), - prsRules = (emptyBag, 0) + prsDecls = (emptyNameEnv, 0), + prsInsts = (emptyBag, 0), + prsRules = (emptyBag, 0), + prsImpMods = emptyFM } ) diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 1b79ee2..228f12c 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -22,7 +22,7 @@ module HscTypes ( TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList, typeEnvClasses, typeEnvTyCons, - WhetherHasOrphans, ImportVersion, WhatsImported(..), + ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..), PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap, IfaceInsts, IfaceRules, GatedDecl, IsExported, NameSupply(..), OrigNameCache, OrigIParamCache, @@ -457,10 +457,11 @@ type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv data PersistentRenamerState - = PRS { prsOrig :: NameSupply, - prsDecls :: DeclsMap, - prsInsts :: IfaceInsts, - prsRules :: IfaceRules + = PRS { prsOrig :: NameSupply, + prsImpMods :: ImportedModuleInfo, + prsDecls :: DeclsMap, + prsInsts :: IfaceInsts, + prsRules :: IfaceRules } \end{code} @@ -490,6 +491,16 @@ type OrigNameCache = FiniteMap (ModuleName,OccName) Name type OrigIParamCache = FiniteMap OccName Name \end{code} +@ImportedModuleInfo@ contains info ONLY about modules that have not yet +been loaded into the iPIT. These modules are mentioned in interfaces we've +already read, so we know a tiny bit about them, but we havn't yet looked +at the interface file for the module itself. It needs to persist across +invocations of the renamer, at least from Rename.checkOldIface to Rename.renameSource. +And there's no harm in it persisting across multiple compilations. + +\begin{code} +type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface) +\end{code} A DeclsMap contains a binding for each Name in the declaration including the constructors of a type decl etc. The Bool is True just diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index d7ccd6e..f7f9c9f 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -20,7 +20,7 @@ module RnHiFiles ( import CmdLineOpts ( opt_IgnoreIfacePragmas ) import HscTypes ( ModuleLocation(..), ModIface(..), emptyModIface, - VersionInfo(..), + VersionInfo(..), ImportedModuleInfo, lookupIfaceByModName, ImportVersion, WhetherHasOrphans, IsBootInterface, DeclsMap, GatedDecl, IfaceInsts, IfaceRules, @@ -232,6 +232,7 @@ tryLoadInterface doc_str mod_name from iRules = new_rules, iImpModInfo = mod_map2 } in + seq mod_map2 $ setIfacesRn new_ifaces `thenRn_` returnRn (mod_iface, Nothing) }} @@ -242,7 +243,7 @@ tryLoadInterface doc_str mod_name from ----------------------------------------------------- addModDeps :: Module - -> (ModuleName -> Bool) -- True for module interfaces + -> (ModuleName -> Bool) -- True for modules that are already loaded -> [ImportVersion a] -> ImportedModuleInfo -> ImportedModuleInfo -- (addModDeps M ivs deps) @@ -255,8 +256,7 @@ addModDeps mod is_loaded new_deps mod_deps -- and in that case, forget about the boot indicator filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))] filtered_new_deps - | isHomeModule mod - = [ (imp_mod, (has_orphans, is_boot)) + | isHomeModule mod = [ (imp_mod, (has_orphans, is_boot)) | (imp_mod, has_orphans, is_boot, _) <- new_deps, not (is_loaded imp_mod) ] diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index ff541af..2a795e5 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -38,8 +38,8 @@ import RdrHsSyn import RnHsSyn ( RenamedFixitySig ) import HscTypes ( AvailEnv, lookupType, NameSupply(..), - WhetherHasOrphans, ImportVersion, - PersistentRenamerState(..), IsBootInterface, Avails, + ImportedModuleInfo, WhetherHasOrphans, ImportVersion, + PersistentRenamerState(..), Avails, DeclsMap, IfaceInsts, IfaceRules, HomeSymbolTable, TyThing, PersistentCompilerState(..), GlobalRdrEnv, @@ -64,7 +64,7 @@ import NameSet import CmdLineOpts ( DynFlags, DynFlag(..), dopt ) import SrcLoc ( SrcLoc, generatedSrcLoc, noSrcLoc ) import Unique ( Unique ) -import FiniteMap ( FiniteMap, emptyFM ) +import FiniteMap ( FiniteMap ) import Bag ( Bag, emptyBag, isEmptyBag, snocBag ) import UniqSupply import Outputable @@ -251,6 +251,11 @@ data Ifaces = Ifaces { -- package symbol table, and the renamer incrementally adds -- to it. + iImpModInfo :: ImportedModuleInfo, + -- Modules that we know something about, because they are mentioned + -- in interface files, BUT which we have not loaded yet. + -- No module is both in here and in the PIT + iDecls :: DeclsMap, -- A single, global map of Names to unslurped decls @@ -265,11 +270,6 @@ data Ifaces = Ifaces { -- EPHEMERAL FIELDS -- These fields persist during the compilation of a single module only - iImpModInfo :: ImportedModuleInfo, - -- Modules that we know something about, because they are mentioned - -- in interface files, BUT which we have not loaded yet. - -- No module is both in here and in the PIT - iSlurp :: NameSet, -- All the names (whether "big" or "small", whether wired-in or not, -- whether locally defined or not) that have been slurped in so far. @@ -282,16 +282,13 @@ data Ifaces = Ifaces { -- names that have been slurped in so far, with their versions. -- This is used to generate the "usage" information for this module. -- Subset of the previous field. + -- -- The module set is the non-home-package modules from which we have -- slurped at least one name. -- It's worth keeping separately, because there's no very easy -- way to distinguish the "big" names from the "non-big" ones. -- But this is a decision we might want to revisit. } - -type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface) - -- Contains info ONLY about modules that - -- have not yet been loaded into the iPIT \end{code} @@ -324,7 +321,7 @@ initRn dflags hit hst pcs mod do_rn iInsts = prsInsts prs, iRules = prsRules prs, - iImpModInfo = emptyFM, + iImpModInfo = prsImpMods prs, iSlurp = unitNameSet (mkUnboundName dummyRdrVarName), -- Pretend that the dummy unbound name has already been -- slurped. This is what's returned for an out-of-scope name, @@ -353,10 +350,11 @@ initRn dflags hit hst pcs mod do_rn (warns, errs) <- readIORef errs_var new_ifaces <- readIORef iface_var new_orig <- readIORef names_var - let new_prs = prs { prsOrig = new_orig, - prsDecls = iDecls new_ifaces, - prsInsts = iInsts new_ifaces, - prsRules = iRules new_ifaces } + let new_prs = prs { prsOrig = new_orig, + prsImpMods = iImpModInfo new_ifaces, + prsDecls = iDecls new_ifaces, + prsInsts = iInsts new_ifaces, + prsRules = iRules new_ifaces } let new_pcs = pcs { pcs_PIT = iPIT new_ifaces, pcs_PRS = new_prs }