From: simonmar Date: Thu, 3 Jan 2002 17:09:15 +0000 (+0000) Subject: [project @ 2002-01-03 17:09:13 by simonmar] X-Git-Tag: Approximately_9120_patches~330 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=224131a71a9edbd6aa8d5a704f1012f8a0a88814;p=ghc-hetmet.git [project @ 2002-01-03 17:09:13 by simonmar] - change the mi_globals field of ModIface to be (Maybe GlobalRdrEnv) from GlobalRdrEnv. The idea is that modules which we have compiled from source will have a complete GlobalRdrEnv in this field containing their top-level environments, whereas modules which we have loaded from object files (package modules and pre-compiled home modules) will have Nothing and we'll create a fake GlobalRdrEnv on demand from the export list. Previously we used to create the fake env all the time, but this way highlights the fact that we don't really have a proper GlobalRdrEnv for these modules (something we'd like to address at some point). - rename CompManager.cmLoadModule to cmLoadModules and make it take a DynFlags argument to be consistent with the rest of the CompManager interface. - split cmLoadModule into two parts: cmDepAnal which takes a list of filenames and returns a ModuleGraph, and cmLoadModules which takes the ModuleGraph and does the rest. This lets the consumer know whether the dependency analysis step fails before unloading any existing modules - i.e. if you :reload and a module is missing, you don't lose the modules that are already loaded (bug reported by MIchael Weber some time ago). --- diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index 54c4344..2958f35 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -1,36 +1,43 @@ % -% (c) The University of Glasgow, 2000 +% (c) The University of Glasgow, 2002 +% +% The Compilation Manager % -\section[CompManager]{The Compilation Manager} - \begin{code} {-# OPTIONS -fvia-C #-} module CompManager ( - cmInit, -- :: GhciMode -> IO CmState + ModuleGraph, + CmRunResult(..), + + CmState, emptyCmState, -- abstract - cmLoadModule, -- :: CmState -> FilePath -> IO (CmState, [String]) + cmInit, -- :: GhciMode -> IO CmState - cmUnload, -- :: CmState -> DynFlags -> IO CmState + cmDepAnal, -- :: CmState -> DynFlags -> [FilePath] -> IO ModuleGraph - cmSetContext, -- :: CmState -> String -> IO CmState + cmLoadModules, -- :: CmState -> DynFlags -> ModuleGraph + -- -> IO (CmState, [String]) - cmGetContext, -- :: CmState -> IO String + cmUnload, -- :: CmState -> DynFlags -> IO CmState + + cmSetContext, -- :: CmState -> String -> IO CmState + + cmGetContext, -- :: CmState -> IO String #ifdef GHCI - cmInfoThing, -- :: CmState -> DynFlags -> String -> IO (Maybe TyThing) + cmInfoThing, -- :: CmState -> DynFlags -> String -> IO (Maybe TyThing) - CmRunResult(..), - cmRunStmt, -- :: CmState -> DynFlags -> String -> IO (CmState, CmRunResult) + cmRunStmt, -- :: CmState -> DynFlags -> String + -- -> IO (CmState, CmRunResult) - cmTypeOfExpr, -- :: CmState -> DynFlags -> String - -- -> IO (CmState, Maybe String) + cmTypeOfExpr, -- :: CmState -> DynFlags -> String + -- -> IO (CmState, Maybe String) - cmTypeOfName, -- :: CmState -> Name -> IO (Maybe String) + cmTypeOfName, -- :: CmState -> Name -> IO (Maybe String) - cmCompileExpr,-- :: CmState -> DynFlags -> String - -- -> IO (CmState, Maybe HValue)#endif + cmCompileExpr, -- :: CmState -> DynFlags -> String + -- -> IO (CmState, Maybe HValue)#endif #endif - CmState, emptyCmState -- abstract ) where @@ -72,7 +79,7 @@ import Id ( idType, idName ) import NameEnv import Type ( tidyType ) import VarEnv ( emptyTidyEnv ) -import RnEnv ( unQualInScope ) +import RnEnv ( unQualInScope, mkIfaceGlobalRdrEnv ) import BasicTypes ( Fixity, defaultFixity ) import Interpreter ( HValue ) import HscMain ( hscStmt ) @@ -226,8 +233,7 @@ cmRunStmt cmstate@CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls, ic=icontext } = do let InteractiveContext { ic_rn_env = rn_env, - ic_type_env = type_env, - ic_module = this_mod } = icontext + ic_type_env = type_env } = icontext (new_pcs, maybe_stuff) <- hscStmt dflags hst hit pcs icontext expr False{-stmt-} @@ -336,8 +342,11 @@ cmTypeOfExpr cmstate dflags expr getUnqual pcs hit ic = case lookupIfaceByModName hit pit modname of Nothing -> alwaysQualify - Just iface -> unQualInScope (mi_globals iface) - where + Just iface -> + case mi_globals iface of + Just env -> unQualInScope env + Nothing -> unQualInScope (mkIfaceGlobalRdrEnv (mi_exports iface)) + where pit = pcs_PIT pcs modname = moduleName (ic_module ic) #endif @@ -410,18 +419,35 @@ cmUnload state@CmState{ gmode=mode, pls=pls, pcs=pcs } dflags new_state <- cmInit mode return new_state{ pcs=pcs, pls=new_pls } + +----------------------------------------------------------------------------- +-- Trace dependency graph + +-- This is a seperate pass so that the caller can back off and keep +-- the current state if the downsweep fails. + +cmDepAnal :: CmState -> DynFlags -> [FilePath] -> IO ModuleGraph +cmDepAnal cmstate dflags rootnames + = do showPass dflags "Chasing dependencies" + when (verbosity dflags >= 1 && gmode cmstate == Batch) $ + hPutStrLn stderr (showSDoc (hcat [ + text progName, text ": chasing modules from: ", + hcat (punctuate comma (map text rootnames))])) + downsweep rootnames (mg cmstate) + ----------------------------------------------------------------------------- -- The real business of the compilation manager: given a system state and -- a module name, try and bring the module up to date, probably changing -- the system state at the same time. -cmLoadModule :: CmState - -> [FilePath] +cmLoadModules :: CmState + -> DynFlags + -> ModuleGraph -> IO (CmState, -- new state Bool, -- was successful [String]) -- list of modules loaded -cmLoadModule cmstate1 rootnames +cmLoadModules cmstate1 dflags mg2unsorted = do -- version 1's are the original, before downsweep let pls1 = pls cmstate1 let pcs1 = pcs cmstate1 @@ -430,21 +456,17 @@ cmLoadModule cmstate1 rootnames -- similarly, ui1 is the (complete) set of linkables from -- the previous pass, if any. let ui1 = ui cmstate1 - let mg1 = mg cmstate1 let ghci_mode = gmode cmstate1 -- this never changes -- Do the downsweep to reestablish the module graph - dflags <- getDynFlags let verb = verbosity dflags - showPass dflags "Chasing dependencies" - when (verb >= 1 && ghci_mode == Batch) $ - hPutStrLn stderr (showSDoc (hcat [ - text progName, text ": chasing modules from: ", - hcat (punctuate comma (map text rootnames))])) + -- Find out if we have a Main module + let a_root_is_Main + = any ((=="Main").moduleNameUserString.name_of_summary) + mg2unsorted - (mg2unsorted, a_root_is_Main) <- downsweep rootnames mg1 let mg2unsorted_names = map name_of_summary mg2unsorted -- reachable_from follows source as well as normal imports @@ -1035,22 +1057,26 @@ topological_sort include_source_imports summaries sccs +----------------------------------------------------------------------------- +-- Downsweep (dependency analysis) + -- Chase downwards from the specified root set, returning summaries -- for all home modules encountered. Only follow source-import --- links. Also returns a Bool to indicate whether any of the roots --- are module Main. -downsweep :: [FilePath] -> [ModSummary] -> IO ([ModSummary], Bool) -downsweep rootNm old_summaries - = do rootSummaries <- mapM getRootSummary rootNm - let a_root_is_Main - = any ((=="Main").moduleNameUserString.name_of_summary) - rootSummaries +-- links. + +-- We pass in the previous collection of summaries, which is used as a +-- cache to avoid recalculating a module summary if the source is +-- unchanged. + +downsweep :: [FilePath] -> [ModSummary] -> IO [ModSummary] +downsweep roots old_summaries + = do rootSummaries <- mapM getRootSummary roots all_summaries <- loop (concat (map ms_imps rootSummaries)) (mkModuleEnv [ (mod, s) | s <- rootSummaries, let mod = ms_mod s, isHomeModule mod ]) - return (all_summaries, a_root_is_Main) + return all_summaries where getRootSummary :: FilePath -> IO ModSummary getRootSummary file @@ -1107,8 +1133,8 @@ downsweep rootNm old_summaries -- We have two types of summarisation: -- --- * Summarise a file. This is used for the root module passed to --- cmLoadModule. The file is read, and used to determine the root +-- * Summarise a file. This is used for the root module(s) passed to +-- cmLoadModules. The file is read, and used to determine the root -- module name. The module name may differ from the filename. -- -- * Summarise a module. We are given a module name, and must provide diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs index 533c295..d1b6b77 100644 --- a/ghc/compiler/ghci/InteractiveUI.hs +++ b/ghc/compiler/ghci/InteractiveUI.hs @@ -1,6 +1,6 @@ {-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-} ----------------------------------------------------------------------------- --- $Id: InteractiveUI.hs,v 1.104 2002/01/03 17:05:50 sewardj Exp $ +-- $Id: InteractiveUI.hs,v 1.105 2002/01/03 17:09:15 simonmar Exp $ -- -- GHC Interactive User Interface -- @@ -463,7 +463,8 @@ addModule str = do dflags <- io (getDynFlags) io (revertCAFs) -- always revert CAFs on load/add. let new_targets = files ++ targets state - (cmstate1, ok, mods) <- io (cmLoadModule (cmstate state) new_targets) + graph <- io (cmDepAnal (cmstate state) dflags new_targets) + (cmstate1, ok, mods) <- io (cmLoadModules (cmstate state) dflags graph) setGHCiState state{ cmstate = cmstate1, targets = new_targets } modulesLoadedMsg ok mods @@ -536,23 +537,39 @@ loadModule' str = do let files = words str state <- getGHCiState dflags <- io getDynFlags + + -- do the dependency anal first, so that if it fails we don't throw + -- away the current set of modules. + graph <- io (cmDepAnal (cmstate state) dflags files) + + -- Dependency anal ok, now unload everything cmstate1 <- io (cmUnload (cmstate state) dflags) setGHCiState state{ cmstate = cmstate1, targets = [] } - io (revertCAFs) -- always revert CAFs on load. - (cmstate2, ok, mods) <- io (cmLoadModule cmstate1 files) + + io (revertCAFs) -- always revert CAFs on load. + (cmstate2, ok, mods) <- io (cmLoadModules cmstate1 dflags graph) + setGHCiState state{ cmstate = cmstate2, targets = files } modulesLoadedMsg ok mods + reloadModule :: String -> GHCi () reloadModule "" = do state <- getGHCiState + dflags <- io getDynFlags case targets state of [] -> io (putStr "no current target\n") - paths - -> do io (revertCAFs) -- always revert CAFs on reload. - (new_cmstate, ok, mods) <- io (cmLoadModule (cmstate state) paths) - setGHCiState state{ cmstate=new_cmstate } - modulesLoadedMsg ok mods + paths -> do + -- do the dependency anal first, so that if it fails we don't throw + -- away the current set of modules. + graph <- io (cmDepAnal (cmstate state) dflags paths) + + io (revertCAFs) -- always revert CAFs on reload. + (new_cmstate, ok, mods) + <- io (cmLoadModules (cmstate state) dflags graph) + + setGHCiState state{ cmstate=new_cmstate } + modulesLoadedMsg ok mods reloadModule _ = noArgs ":reload" diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 756aa6f..bf85769 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -147,7 +147,10 @@ data ModIface = ModIface { mi_module :: !Module, -- Complete with package info mi_version :: !VersionInfo, -- Module version number + mi_orphan :: WhetherHasOrphans, -- Whether this module has orphans + -- NOT STRICT! we fill this field with _|_ sometimes + mi_boot :: !IsBootInterface, -- read from an hi-boot file? mi_usages :: ![ImportVersion Name], @@ -159,12 +162,15 @@ data ModIface -- What it exports Kept sorted by (mod,occ), to make -- version comparisons easier - mi_globals :: !GlobalRdrEnv, -- Its top level environment + mi_globals :: !(Maybe GlobalRdrEnv), + -- Its top level environment or Nothing if we read this + -- interface from a file. mi_fixities :: !(NameEnv Fixity), -- Fixities mi_deprecs :: !Deprecations, -- Deprecations mi_decls :: IfaceDecls -- The RnDecls form of ModDetails + -- NOT STRICT! we fill this field with _|_ sometimes } data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted @@ -236,7 +242,7 @@ emptyModIface mod mi_boot = False, mi_exports = [], mi_fixities = emptyNameEnv, - mi_globals = emptyRdrEnv, + mi_globals = Nothing, mi_deprecs = NoDeprecs, mi_decls = panic "emptyModIface: decls" } diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 873b758..b092251 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -193,7 +193,13 @@ loadContextModule scope_module thing_inside = let doc = text "context for compiling expression" in loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface -> - let rdr_env = mi_globals iface + + -- If this is a module we previously compiled, then mi_globals will + -- have its top-level environment. If it is an imported module, then + -- we must invent a top-level environment from its exports. + let rdr_env | Just env <- mi_globals iface = env + | otherwise = mkIfaceGlobalRdrEnv (mi_exports iface) + print_unqual = unQualInScope rdr_env in checkErrsRn `thenRn` \ no_errs_so_far -> @@ -345,7 +351,7 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec mi_boot = False, mi_orphan = panic "is_orphan", mi_exports = my_exports, - mi_globals = gbl_env, + mi_globals = Just gbl_env, mi_fixities = fixities, mi_deprecs = my_deprecs, mi_decls = panic "mi_decls" @@ -357,7 +363,7 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec -- REPORT UNUSED NAMES, AND DEBUG DUMP reportUnusedNames mod_iface print_unqualified - imports full_avail_env + imports full_avail_env gbl_env source_fvs2 rn_imp_decls `thenRn_` -- NB: source_fvs2: include exports (else we get bogus -- warnings of unused things) but not implicit FVs. @@ -531,7 +537,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 = mkIfaceGlobalRdrEnv avails + mi_globals = Nothing } in returnRn mod_iface @@ -634,10 +640,11 @@ closeIfaceDecls dflags hit hst pcs reportUnusedNames :: ModIface -> PrintUnqualified -> [RdrNameImportDecl] -> AvailEnv + -> GlobalRdrEnv -> NameSet -- Used in this module -> [RenamedHsDecl] -> RnMG () -reportUnusedNames my_mod_iface unqual imports avail_env +reportUnusedNames my_mod_iface unqual imports avail_env gbl_env used_names imported_decls = warnUnusedModules unused_imp_mods `thenRn_` warnUnusedLocalBinds bad_locals `thenRn_` @@ -645,7 +652,6 @@ reportUnusedNames my_mod_iface unqual imports avail_env printMinimalImports this_mod unqual minimal_imports where this_mod = mi_module my_mod_iface - gbl_env = mi_globals my_mod_iface -- Now, a use of C implies a use of T, -- if C was brought into scope by T(..) or T(C) diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index fbf9e79..45fb805 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -227,7 +227,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 = mkIfaceGlobalRdrEnv avails + mi_globals = Nothing } new_ifaces = ifaces { iPIT = new_pit,