From e4f0e4adfb32f0f562dc2dda9fc2c1c7fe71b202 Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 20 Oct 2000 15:38:43 +0000 Subject: [PATCH] [project @ 2000-10-20 15:38:42 by sewardj] Latest hacks. --- ghc/compiler/ghci/CompManager.lhs | 4 +- ghc/compiler/main/HscTypes.lhs | 99 ++++++++++++++++++------------------- ghc/compiler/rename/Rename.lhs | 10 ++-- ghc/compiler/rename/RnIfaces.lhs | 6 +-- ghc/compiler/rename/RnMonad.lhs | 38 ++++++++------ ghc/compiler/rename/RnNames.lhs | 2 +- 6 files changed, 79 insertions(+), 80 deletions(-) diff --git a/ghc/compiler/ghci/CompManager.lhs b/ghc/compiler/ghci/CompManager.lhs index 7370668..0c4998d 100644 --- a/ghc/compiler/ghci/CompManager.lhs +++ b/ghc/compiler/ghci/CompManager.lhs @@ -58,7 +58,7 @@ type ModHandle = String -- ToDo: do better? data PersistentCMState = PersistentCMState { hst :: HomeSymbolTable, -- home symbol table - hit :: HomeInterfaceTable, -- home interface table + hit :: HomeIfaceTable, -- home interface table ui :: UnlinkedImages, -- the unlinked images mg :: ModuleGraph -- the module graph } @@ -69,7 +69,7 @@ emptyPCMS = PersistentCMState hst = emptyHST, hit = emptyHIT, ui = emptyUI, mg = emptyMG } -emptyHIT :: HomeInterfaceTable +emptyHIT :: HomeIfaceTable emptyHIT = emptyFM emptyHST :: HomeSymbolTable emptyHST = emptyFM diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 63f80de..a24813d 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -5,8 +5,9 @@ \begin{code} module HscTypes ( - ModDetails(..), GlobalSymbolTable, + ModDetails(..), ModIface(..), GlobalSymbolTable, HomeSymbolTable, PackageSymbolTable, + HomeIfaceTable, PackageIfaceTable, TyThing(..), groupTyThings, @@ -39,7 +40,7 @@ import Name ( Name, NameEnv, NamedThing, unitNameEnv, extendNameEnv, plusNameEnv, lookupNameEnv, emptyNameEnv, getName, nameModule, nameSrcLoc ) -import Module ( Module, ModuleName, +import Module ( Module, ModuleName, ModuleEnv, extendModuleEnv, lookupModuleEnv ) import Class ( Class ) import OccName ( OccName ) @@ -62,11 +63,13 @@ import HsDecls ( DeprecTxt ) import CoreSyn ( CoreRule ) import NameSet ( NameSet ) import Type ( Type ) +import Name ( emptyNameEnv ) import VarSet ( TyVarSet ) import Panic ( panic ) import Outputable import SrcLoc ( SrcLoc, isGoodSrcLoc ) import Util ( thenCmp ) +import RnHsSyn ( RenamedHsDecl ) \end{code} %************************************************************************ @@ -81,55 +84,48 @@ and can be written out to an interface file. The @ModDetails@ is after linking; it is the "linked" form of the mi_decls field. \begin{code} -data ModDetails - = ModDetails { - md_module :: Module, -- Complete with package info - md_version :: VersionInfo, -- Module version number - md_orphan :: WhetherHasOrphans, -- Whether this module has orphans - md_usages :: [ImportVersion Name], -- Usages +data ModIface + = ModIface { + mi_module :: Module, -- Complete with package info + mi_version :: VersionInfo, -- Module version number + mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans + mi_usages :: [ImportVersion Name], -- Usages - md_exports :: Avails, -- What it exports - md_globals :: GlobalRdrEnv, -- Its top level environment + mi_exports :: Avails, -- What it exports + mi_globals :: GlobalRdrEnv, -- Its top level environment - md_fixities :: NameEnv Fixity, -- Fixities - md_deprecs :: NameEnv DeprecTxt, -- Deprecations + mi_fixities :: NameEnv Fixity, -- Fixities + mi_deprecs :: NameEnv DeprecTxt, -- Deprecations + + mi_decls :: [RenamedHsDecl] -- types, classes + -- inst decls, rules, iface sigs + } +-- typechecker should only look at this, not ModIface +-- Should be able to construct ModDetails from mi_decls in ModIface +data ModDetails + = ModDetails { -- The next three fields are created by the typechecker md_types :: TypeEnv, md_insts :: [DFunId], -- Dfun-ids for the instances in this module md_rules :: RuleEnv -- Domain may include Ids from other modules } - --- ModIFace is nearly the same as RnMonad.ParsedIface. --- Right now it's identical :) -data ModIFace - = ModIFace { - mi_mod :: Module, -- Complete with package info - mi_vers :: Version, -- Module version number - mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans - mi_usages :: [ImportVersion OccName], -- Usages - mi_exports :: [ExportItem], -- Exports - mi_insts :: [RdrNameInstDecl], -- Local instance declarations - mi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions - mi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, - -- with their version - mi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version - mi_deprecs :: [RdrNameDeprecation] -- Deprecations - } - \end{code} \begin{code} -emptyModDetails :: Module -> ModDetails -emptyModDetails mod - = ModDetails { md_module = mod, - md_exports = [], - md_globals = emptyRdrEnv, - md_fixities = emptyNameEnv, - md_deprecs = emptyNameEnv, - md_types = emptyNameEnv, - md_insts = [], - md_rules = emptyRuleEnv +emptyModDetails :: ModDetails +emptyModDetails + = ModDetails { md_types = emptyTypeEnv, + md_insts = [], + md_rules = emptyRuleEnv + } + +emptyModIface :: Module -> ModIface +emptyModIface mod + = ModIface { mi_module = mod, + mi_exports = [], + mi_globals = emptyRdrEnv, + mi_deprecs = emptyNameEnv, } \end{code} @@ -137,6 +133,11 @@ Symbol tables map modules to ModDetails: \begin{code} type SymbolTable = ModuleEnv ModDetails +type IfaceTable = ModuleEnv ModIface + +type HomeIfaceTable = IfaceTable +type PackageIfaceTable = IfaceTable + type HomeSymbolTable = SymbolTable -- Domain = modules in the home package type PackageSymbolTable = SymbolTable -- Domain = modules in the some other package type GlobalSymbolTable = SymbolTable -- Domain = all modules @@ -145,12 +146,12 @@ type GlobalSymbolTable = SymbolTable -- Domain = all modules Simple lookups in the symbol table. \begin{code} -lookupFixityEnv :: SymbolTable -> Name -> Maybe Fixity +lookupFixityEnv :: IfaceTable -> Name -> Maybe Fixity -- Returns defaultFixity if there isn't an explicit fixity lookupFixityEnv tbl name = case lookupModuleEnv tbl (nameModule name) of Nothing -> Nothing - Just details -> lookupNameEnv (md_fixities details) name + Just details -> lookupNameEnv (mi_fixities details) name \end{code} @@ -162,6 +163,7 @@ lookupFixityEnv tbl name \begin{code} type TypeEnv = NameEnv TyThing +emptyTypeEnv = emptyNameEnv data TyThing = AnId Id | ATyCon TyCon @@ -205,7 +207,7 @@ extendTypeEnv tbl things where new_details = case lookupModuleEnv tbl mod of - Nothing -> (emptyModDetails mod) {md_types = type_env} + Nothing -> emptyModDetails {md_types = type_env} Just details -> details {md_types = md_types details `plusNameEnv` type_env} \end{code} @@ -400,7 +402,7 @@ type GatedDecl = (NameSet, (Module, RdrNameHsDecl)) \begin{code} data CompResult = CompOK ModDetails -- new details (HST additions) - (Maybe (ModIFace, Linkable)) + (Maybe (ModIface, Linkable)) -- summary and code; Nothing => compilation not reqd -- (old summary and code are still valid) PersistentCompilerState -- updated PCS @@ -419,7 +421,7 @@ data CompResult data HscResult = HscOK ModDetails -- new details (HomeSymbolTable additions) - (Maybe ModIFace) -- new iface (if any compilation was done) + (Maybe ModIface) -- new iface (if any compilation was done) (Maybe String) -- generated stub_h filename (in /tmp) (Maybe String) -- generated stub_c filename (in /tmp) (Maybe [UnlinkedIBind]) -- interpreted code, if any @@ -429,13 +431,6 @@ data HscResult | HscErrs PersistentCompilerState -- updated PCS (Bag ErrMsg) -- errors (Bag WarnMsg) -- warnings - --- These two are only here to avoid recursion between CmCompile and --- CompManager. They really ought to be in the latter. -type ModuleEnv a = UniqFM a -- Domain is Module - -type HomeModMap = FiniteMap ModuleName Module -- domain: home mods only -type HomeInterfaceTable = ModuleEnv ModIFace \end{code} diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 1f7ba61..04ed446 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -84,11 +84,9 @@ type FixityEnv = LocalFixityEnv \begin{code} type RenameResult = ( PersistentCompilerState - , Module -- This module - , RenamedHsModule -- Renamed module - , Maybe ParsedIface -- The existing interface file, if any - , ParsedIface -- The new interface - , [Module]) -- Imported modules + , ModIface -- The mi_decls in here include + -- ones imported from packages too + ) renameModule :: DynFlags -> Finder -> PersistentCompilerState -> HomeSymbolTable @@ -193,7 +191,7 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec l | FixitySig name fixity loc <- nameEnvElts local_fixity_env, isUserExportedName name ] - + ------ HERE new_iface = ParsedIface { pi_mod = this_module , pi_vers = initialVersion , pi_orphan = any isOrphanDecl rn_local_decls diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index 1d4711f..07f07cd 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -217,12 +217,12 @@ tryLoadInterface doc_str mod_name from mod_map2 = addToFM mod_map1 mod_name (pi_orphan iface, hi_boot_file, True) -- Now add info about this module to the PST - new_pst = extendModuleEnv pst mod mod_detils - mod_details = ModDetails { mdModule = mod, mvVersion = version, + new_pit = extendModuleEnv pit mod mod_iface + mod_iface = ModIface { mdModule = mod, mvVersion = version, mdExports = avails, mdFixEnv = fix_env, mdDeprecEnv = deprec_env } - new_ifaces = ifaces { iPST = new_pst, + new_ifaces = ifaces { iPIT = new_pit, iDecls = new_decls, iInsts = new_insts, iRules = new_rules, diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index ddff54f..8f5270d 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -66,7 +66,8 @@ import HscTypes ( GlobalSymbolTable, AvailEnv, PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap, IfaceInsts, IfaceRules, DeprecationEnv, HomeSymbolTable, PackageSymbolTable, - PersistentCompilerState(..), GlobalRdrEnv ) + PersistentCompilerState(..), GlobalRdrEnv, + HomeIfaceTable, PackageIfaceTable ) infixr 9 `thenRn`, `thenRn_` \end{code} @@ -118,7 +119,8 @@ data RnDown rn_finder :: Finder, rn_dflags :: DynFlags, - rn_hst :: HomeSymbolTable, + rn_hit :: HomeIfaceTable, + rn_done :: Name -> Bool, -- available before compiling this module? rn_errs :: IORef (Bag WarnMsg, Bag ErrMsg), @@ -194,7 +196,8 @@ data ParsedIface pi_exports :: [ExportItem], -- Exports pi_insts :: [RdrNameInstDecl], -- Local instance declarations pi_decls :: [(Version, RdrNameHsDecl)], -- Local definitions - pi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, with their version + pi_fixity :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, + -- with their version pi_rules :: (Version, [RdrNameRuleDecl]), -- Rules, with their version pi_deprecs :: [RdrNameDeprecation] -- Deprecations } @@ -209,18 +212,18 @@ data ParsedIface \begin{code} data Ifaces = Ifaces { -- PERSISTENT FIELDS - iPST :: PackageSymbolTable, - -- The ModuleDetails for modules in other packages + iPIT :: PackageIfaceTable, + -- The ModuleIFaces for modules in other packages -- whose interfaces we have opened - -- The contents of those interface files may be mostly - -- in the iDecls, iInsts, iRules (below), but what *will* - -- be in the PackageSymbolTable is: + -- The declarations in these interface files are held in + -- iDecls, iInsts, iRules (below), not in the mi_decls fields + -- of the iPIT. What _is_ in the iPIT is: -- * The Module -- * Version info -- * Its exports -- * Fixities -- * Deprecations - -- This field is initialised from the compiler's persistent + -- The iPIT field is initialised from the compiler's persistent -- package symbol table, and the renamer incrementally adds -- to it. @@ -268,13 +271,16 @@ type IsLoaded = Bool %************************************************************************ \begin{code} -initRn :: DynFlags -> Finder -> HomeSymbolTable +initRn :: DynFlags + -> Finder + -> HomeIfaceTable -> PersistentCompilerState - -> Module -> SrcLoc + -> Module + -> SrcLoc -> RnMG t -> IO (t, PersistentCompilerState, (Bag WarnMsg, Bag ErrMsg)) -initRn dflags finder hst pcs mod loc do_rn +initRn dflags finder hit pcs mod loc do_rn = do let prs = pcs_PRS pcs uniqs <- mkSplitUniqSupply 'r' @@ -287,7 +293,7 @@ initRn dflags finder hst pcs mod loc do_rn rn_finder = finder, rn_dflags = dflags, - rn_hst = hst, + rn_hit = hit, rn_ns = names_var, rn_errs = errs_var, @@ -530,7 +536,7 @@ getDOptsRn (RnDown { rn_dflags = dflags}) l_down %================ -\subsubsection{ Source location} +\subsubsection{Source location} %===================== \begin{code} @@ -551,8 +557,8 @@ getSrcLocRn down l_down getFinderRn :: RnM d Finder getFinderRn down l_down = return (rn_finder down) -getHomeSymbolTableRn :: RnM d HomeSymbolTable -getHomeSymbolTableRn down l_down = return (rn_hst down) +getHomeIfaceTableRn :: RnM d HomeIfaceTable +getHomeIfaceTableRn down l_down = return (rn_hit down) \end{code} %================ diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 877974c..4b17019 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -126,7 +126,7 @@ getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc) -- to compile A, and of course that doesn't include B.f. That's -- why we wait till after the plusEnv stuff to do the early-exit. - -- Check For eacly exit + -- Check For early exit checkErrsRn `thenRn` \ no_errs_so_far -> if not no_errs_so_far then -- Found errors already, so exit now -- 1.7.10.4