Commit 93cc7d22 authored by wolfgang's avatar wolfgang
Browse files

[project @ 2005-04-13 21:42:17 by wolfgang]

Make the status messages from ghc --make display the number of modules
to be compiled, as in:

[3 of 9] Compiling Foo.hs     ( Foo.hs, Foo.o )
parent b0422639
......@@ -93,6 +93,7 @@ compile :: HscEnv
-> ModSummary
-> Maybe Linkable -- Just linkable <=> source unchanged
-> Maybe ModIface -- Old interface, if available
-> Int -> Int
-> IO CompResult
data CompResult
......@@ -103,7 +104,7 @@ data CompResult
| CompErrs
compile hsc_env msg_act mod_summary maybe_old_linkable old_iface = do
compile hsc_env msg_act mod_summary maybe_old_linkable old_iface mod_index nmods = do
let dflags0 = hsc_dflags hsc_env
this_mod = ms_mod mod_summary
......@@ -160,6 +161,7 @@ compile hsc_env msg_act mod_summary maybe_old_linkable old_iface = do
-- run the compiler
hsc_result <- hscMain hsc_env' msg_act mod_summary
source_unchanged have_object old_iface
(Just (mod_index, nmods))
case hsc_result of
HscFail -> return CompErrs
......@@ -702,6 +704,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
mod_summary source_unchanged
False -- No object file
Nothing -- No iface
Nothing -- No "module i of n" progress info
case result of
......
......@@ -872,22 +872,26 @@ upsweep
HscEnv, -- With an updated HPT
[ModSummary]) -- Mods which succeeded
upsweep hsc_env old_hpt stable_mods cleanup msg_act mods
= upsweep' hsc_env old_hpt stable_mods cleanup msg_act mods 1 (length mods)
upsweep hsc_env old_hpt stable_mods cleanup msg_act
[]
[] _ _
= return (Succeeded, hsc_env, [])
upsweep hsc_env old_hpt stable_mods cleanup msg_act
(CyclicSCC ms:_)
(CyclicSCC ms:_) _ _
= do putMsg (showSDoc (cyclicModuleErr ms))
return (Failed, hsc_env, [])
upsweep hsc_env old_hpt stable_mods cleanup msg_act
(AcyclicSCC mod:mods)
(AcyclicSCC mod:mods) mod_index nmods
= do -- putStrLn ("UPSWEEP_MOD: hpt = " ++
-- show (map (moduleUserString.moduleName.mi_module.hm_iface)
-- (moduleEnvElts (hsc_HPT hsc_env)))
mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods msg_act mod
mod_index nmods
cleanup -- Remove unwanted tmp files between compilations
......@@ -912,7 +916,7 @@ upsweep hsc_env old_hpt stable_mods cleanup msg_act
; (restOK, hsc_env2, modOKs)
<- upsweep hsc_env1 old_hpt1 stable_mods cleanup
msg_act mods
msg_act mods (mod_index+1) nmods
; return (restOK, hsc_env2, mod:modOKs)
}
......@@ -924,9 +928,11 @@ upsweep_mod :: HscEnv
-> ([Module],[Module])
-> (Messages -> IO ())
-> ModSummary
-> Int -- index of module
-> Int -- total number of modules
-> IO (Maybe HomeModInfo) -- Nothing => Failed
upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) msg_act summary
upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) msg_act summary mod_index nmods
= do
let
this_mod = ms_mod summary
......@@ -936,7 +942,7 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) msg_act summary
compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
compile_it = upsweep_compile hsc_env old_hpt this_mod
msg_act summary
msg_act summary mod_index nmods
case ghcMode (hsc_dflags hsc_env) of
BatchCompile ->
......@@ -989,7 +995,9 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) msg_act summary
old_hmi = lookupModuleEnv old_hpt this_mod
-- Run hsc to compile a module
upsweep_compile hsc_env old_hpt this_mod msg_act summary mb_old_linkable = do
upsweep_compile hsc_env old_hpt this_mod msg_act summary
mod_index nmods
mb_old_linkable = do
let
-- The old interface is ok if it's in the old HPT
-- a) we're compiling a source file, and the old HPT
......@@ -1010,6 +1018,7 @@ upsweep_compile hsc_env old_hpt this_mod msg_act summary mb_old_linkable = do
iface = hm_iface hm_info
compresult <- compile hsc_env msg_act summary mb_old_linkable mb_old_iface
mod_index nmods
case compresult of
-- Compilation failed. Compile may still have updated the PCS, tho.
......
......@@ -166,10 +166,12 @@ hscMain
-> Bool -- True <=> source unchanged
-> Bool -- True <=> have an object file (for msgs only)
-> Maybe ModIface -- Old interface, if available
-> Maybe (Int, Int) -- Just (i,n) <=> module i of n (for msgs)
-> IO HscResult
hscMain hsc_env msg_act mod_summary
source_unchanged have_object maybe_old_iface
mb_mod_index
= do {
(recomp_reqd, maybe_checked_iface) <-
{-# SCC "checkOldIface" #-}
......@@ -182,6 +184,7 @@ hscMain hsc_env msg_act mod_summary
; what_next hsc_env msg_act mod_summary have_object
maybe_checked_iface
mb_mod_index
}
......@@ -189,6 +192,7 @@ hscMain hsc_env msg_act mod_summary
-- hscNoRecomp definitely expects to have the old interface available
hscNoRecomp hsc_env msg_act mod_summary
have_object (Just old_iface)
mb_mod_index
| isOneShot (ghcMode (hsc_dflags hsc_env))
= do {
compilationProgressMsg (hsc_dflags hsc_env) $
......@@ -200,7 +204,8 @@ hscNoRecomp hsc_env msg_act mod_summary
}
| otherwise
= do { compilationProgressMsg (hsc_dflags hsc_env) $
("Skipping " ++ showModMsg have_object mod_summary)
(showModuleIndex mb_mod_index ++
"Skipping " ++ showModMsg have_object mod_summary)
; new_details <- {-# SCC "tcRnIface" #-}
typecheckIface hsc_env old_iface ;
......@@ -212,13 +217,14 @@ hscNoRecomp hsc_env msg_act mod_summary
------------------------------
hscRecomp hsc_env msg_act mod_summary
have_object maybe_checked_iface
mb_mod_index
= case ms_hsc_src mod_summary of
HsSrcFile -> do
front_res <- hscFileFrontEnd hsc_env msg_act mod_summary
front_res <- hscFileFrontEnd hsc_env msg_act mod_summary mb_mod_index
hscBackEnd hsc_env mod_summary maybe_checked_iface front_res
HsBootFile -> do
front_res <- hscFileFrontEnd hsc_env msg_act mod_summary
front_res <- hscFileFrontEnd hsc_env msg_act mod_summary mb_mod_index
hscBootBackEnd hsc_env mod_summary maybe_checked_iface front_res
ExtCoreFile -> do
......@@ -246,7 +252,7 @@ hscCoreFrontEnd hsc_env msg_act mod_summary = do {
}}
hscFileFrontEnd hsc_env msg_act mod_summary = do {
hscFileFrontEnd hsc_env msg_act mod_summary mb_mod_index = do {
-------------------
-- DISPLAY PROGRESS MESSAGE
-------------------
......@@ -255,7 +261,8 @@ hscFileFrontEnd hsc_env msg_act mod_summary = do {
; let toInterp = hscTarget dflags == HscInterpreted
; when (not one_shot) $
compilationProgressMsg dflags $
("Compiling " ++ showModMsg (not toInterp) mod_summary)
(showModuleIndex mb_mod_index ++
"Compiling " ++ showModMsg (not toInterp) mod_summary)
-------------------
-- PARSE
......@@ -801,3 +808,19 @@ dumpIfaceStats hsc_env
dump_rn_stats = dopt Opt_D_dump_rn_stats dflags
dump_if_trace = dopt Opt_D_dump_if_trace dflags
\end{code}
%************************************************************************
%* *
Progress Messages: Module i of n
%* *
%************************************************************************
\begin{code}
showModuleIndex Nothing = ""
showModuleIndex (Just (i,n)) = "[" ++ padded ++ " of " ++ n_str ++ "] "
where
n_str = show n
i_str = show i
padded = replicate (length n_str - length i_str) ' ' ++ i_str
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment