From cf2aab8a7cb0b74ec23453639503dd8c6f8e1353 Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 15 Mar 2001 11:26:27 +0000 Subject: [PATCH] [project @ 2001-03-15 11:26:27 by simonmar] Do a better job of telling the user whether we're interpreting a module or using an existing object file. eg. Main> :load A Skipping D ( D.hs, D.o ) Compiling C ( C.hs, interpreted ) Skipping B ( B.hs, B.o ) Compiling Main ( A.hs, interpreted ) Main> --- ghc/compiler/compMan/CompManager.lhs | 50 ++++++++++++---------------------- ghc/compiler/main/DriverPipeline.hs | 11 +++++--- ghc/compiler/main/HscMain.lhs | 34 +++++++++++++++-------- 3 files changed, 47 insertions(+), 48 deletions(-) diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index f2ba82a..c6902be 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -801,7 +801,7 @@ upsweep_mod :: GhciMode -> [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 @@ -813,54 +813,40 @@ upsweep_mod ghci_mode dflags oldUI threaded1 summary1 reachable_from_here 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. diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 2b69fa7..5a433fa 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 -- @@ -483,6 +483,7 @@ run_phase Hsc basename suff input_fn output_fn mod location{ ml_hspp_file=Just input_fn } source_unchanged + False Nothing -- no iface emptyModuleEnv -- HomeSymbolTable emptyModuleEnv -- HomeIfaceTable @@ -842,7 +843,8 @@ preprocess filename = 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 @@ -860,7 +862,8 @@ data CompResult | 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 @@ -891,7 +894,7 @@ compile ghci_mode summary source_unchanged old_iface hst hit pcs = do -- 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) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 90ca27e..86984d8 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -111,14 +111,16 @@ hscMain -> 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) @@ -137,13 +139,14 @@ hscMain ghci_mode dflags mod location source_unchanged maybe_old_iface hst hit p 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"; @@ -153,7 +156,8 @@ hscNoRecomp ghci_mode dflags mod location (Just old_iface) hst hit pcs_ch | 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) @@ -173,20 +177,26 @@ hscNoRecomp ghci_mode dflags mod location (Just old_iface) hst hit pcs_ch 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 ------------------- -- 1.7.10.4