-> [ModuleName]
-> IO (CmThreaded, Maybe Linkable)
-upsweep_mod ghci_mode dflags oldUI threaded1 summary1 reachable_from_here
+upsweep_mod ghci_mode dflags oldUI threaded1 summary1 reachable_inc_me
= do
let mod_name = name_of_summary summary1
let verb = verbosity dflags
source_unchanged = isJust maybe_old_linkable
+ reachable_only = filter (/= (name_of_summary summary1))
+ reachable_inc_me
+
-- in interactive mode, all home modules below us *must* have an
-- interface in the HIT. We never demand-load home interfaces in
-- interactive mode.
(hst1_strictDC, hit1_strictDC)
= ASSERT(ghci_mode == Batch ||
- all (`elemUFM` hit1) reachable_from_here)
- retainInTopLevelEnvs
- (filter (/= (name_of_summary summary1)) reachable_from_here)
- (hst1,hit1)
+ all (`elemUFM` hit1) reachable_only)
+ retainInTopLevelEnvs reachable_only (hst1,hit1)
old_linkable
= unJust "upsweep_mod:old_linkable" maybe_old_linkable
+ have_object
+ | Just l <- maybe_old_linkable, isObjectLinkable l = True
+ | otherwise = False
+
compresult <- compile ghci_mode summary1 source_unchanged
- old_iface hst1_strictDC hit1_strictDC pcs1
+ have_object old_iface hst1_strictDC hit1_strictDC pcs1
case compresult of
- -- Compilation "succeeded", but didn't return a new
- -- linkable, meaning that compilation wasn't needed, and the
- -- new details were manufactured from the old iface.
- CompOK pcs2 new_details new_iface Nothing
- -> do let hst2 = addToUFM hst1 mod_name new_details
- hit2 = addToUFM hit1 mod_name new_iface
- threaded2 = CmThreaded pcs2 hst2 hit2
-
- if ghci_mode == Interactive && verb >= 1 then
- -- if we're using an object file, tell the user
- case old_linkable of
- (LM _ _ objs@(DotO _:_))
- -> do hPutStrLn stderr (showSDoc (space <>
- parens (hsep (text "using":
- punctuate comma
- [ text o | DotO o <- objs ]))))
- _ -> return ()
- else
- return ()
-
- return (threaded2, Just old_linkable)
-
- -- Compilation really did happen, and succeeded. A new
- -- details, iface and linkable are returned.
- CompOK pcs2 new_details new_iface (Just new_linkable)
+ -- Compilation "succeeded", and may or may not have returned a new
+ -- linkable (depending on whether compilation was actually performed
+ -- or not).
+ CompOK pcs2 new_details new_iface maybe_new_linkable
-> do let hst2 = addToUFM hst1 mod_name new_details
hit2 = addToUFM hit1 mod_name new_iface
threaded2 = CmThreaded pcs2 hst2 hit2
- return (threaded2, Just new_linkable)
+ return (threaded2, if isJust maybe_new_linkable
+ then maybe_new_linkable
+ else Just old_linkable)
-- Compilation failed. compile may still have updated
-- the PCS, tho.
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.54 2001/03/13 14:58:26 simonpj Exp $
+-- $Id: DriverPipeline.hs,v 1.55 2001/03/15 11:26:27 simonmar Exp $
--
-- GHC Driver
--
mod
location{ ml_hspp_file=Just input_fn }
source_unchanged
+ False
Nothing -- no iface
emptyModuleEnv -- HomeSymbolTable
emptyModuleEnv -- HomeIfaceTable
compile :: GhciMode -- distinguish batch from interactive
-> ModSummary -- summary, including source
- -> Bool -- source unchanged?
+ -> Bool -- True <=> source unchanged
+ -> Bool -- True <=> have object
-> Maybe ModIface -- old interface, if available
-> HomeSymbolTable -- for home module ModDetails
-> HomeIfaceTable -- for home module Ifaces
| CompErrs PersistentCompilerState -- updated PCS
-compile ghci_mode summary source_unchanged old_iface hst hit pcs = do
+compile ghci_mode summary source_unchanged have_object
+ old_iface hst hit pcs = do
init_dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags init_dyn_flags
-- run the compiler
hsc_result <- hscMain ghci_mode dyn_flags{ hscOutName = output_fn }
(ms_mod summary) location
- source_unchanged old_iface hst hit pcs
+ source_unchanged have_object old_iface hst hit pcs
case hsc_result of
HscFail pcs -> return (CompErrs pcs)
-> DynFlags
-> Module
-> ModuleLocation -- location info
- -> Bool -- source unchanged?
+ -> Bool -- True <=> source unchanged
+ -> Bool -- True <=> have an object file (for msgs only)
-> Maybe ModIface -- old interface, if available
-> HomeSymbolTable -- for home module ModDetails
-> HomeIfaceTable
-> PersistentCompilerState -- IN: persistent compiler state
-> IO HscResult
-hscMain ghci_mode dflags mod location source_unchanged maybe_old_iface hst hit pcs
+hscMain ghci_mode dflags mod location source_unchanged have_object
+ maybe_old_iface hst hit pcs
= do {
showPass dflags ("Checking old interface for hs = "
++ show (ml_hs_file location)
what_next | recomp_reqd || no_old_iface = hscRecomp
| otherwise = hscNoRecomp
;
- what_next ghci_mode dflags mod location maybe_checked_iface
- hst hit pcs_ch
+ what_next ghci_mode dflags have_object mod location
+ maybe_checked_iface hst hit pcs_ch
}}
-- we definitely expect to have the old interface available
-hscNoRecomp ghci_mode dflags mod location (Just old_iface) hst hit pcs_ch
+hscNoRecomp ghci_mode dflags have_object
+ mod location (Just old_iface) hst hit pcs_ch
| ghci_mode == OneShot
= do {
hPutStrLn stderr "compilation IS NOT required";
| otherwise
= do {
when (verbosity dflags >= 1) $
- hPutStrLn stderr ("Skipping " ++ compMsg mod location);
+ hPutStrLn stderr ("Skipping " ++
+ compMsg have_object mod location);
-- CLOSURE
(pcs_cl, closure_errs, cl_hs_decls)
return (HscNoRecomp pcs_tc new_details old_iface)
}}}
-compMsg mod location =
+compMsg use_object mod location =
mod_str ++ take (max 0 (16 - length mod_str)) (repeat ' ')
- ++ " (" ++ unJust "hscRecomp" (ml_hs_file location) ++ ")"
+ ++" ( " ++ unJust "hscRecomp" (ml_hs_file location) ++ ", "
+ ++ (if use_object
+ then unJust "hscRecomp" (ml_obj_file location)
+ else "interpreted")
+ ++ " )"
where mod_str = moduleUserString mod
-hscRecomp ghci_mode dflags mod location maybe_checked_iface hst hit pcs_ch
+hscRecomp ghci_mode dflags have_object
+ mod location maybe_checked_iface hst hit pcs_ch
= do {
- ; when (verbosity dflags >= 1) $
- hPutStrLn stderr ("Compiling " ++ compMsg mod location);
-
-- what target are we shooting for?
; let toInterp = dopt_HscLang dflags == HscInterpreted
+ ; when (verbosity dflags >= 1) $
+ hPutStrLn stderr ("Compiling " ++
+ compMsg (not toInterp) mod location);
+
-------------------
-- PARSE
-------------------
projects / ghc-hetmet.git / commitdiff