%
-% (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
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 )
= 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-}
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
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
-- 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
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
-- 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
{-# 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
--
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
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"
= 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 ->
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"
-- 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.
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
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_`
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)
projects / ghc-hetmet.git / commitdiff