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