Progress info for --make
Wolfgang Thaller
wolfgang.thaller at gmx.net
Wed Apr 13 00:11:27 EDT 2005
Hi all,
Are there any objections against making the output of ghc --make just a
little bit more informative:
> Chasing modules from: HOC.hs
> [ 1 of 18] Compiling HOC.SelectorNameMangling (
> ./HOC/SelectorNameMangling.hs,
> build/objects/HOC/SelectorNameMangling.o )
> [ 2 of 18] Skipping HOC.Base ( ./HOC/Base.hs,
> build/objects/HOC/Base.o )
> [ 3 of 18] Skipping HOC.TH ( ./HOC/TH.hs,
> build/objects/HOC/TH.o )
> [ 4 of 18] Skipping HOC.FFICallInterface ( ./HOC/FFICallInterface.hs,
> build/objects/HOC/FFICallInterface.o )
> [ 5 of 18] Skipping HOC.Arguments ( ./HOC/Arguments.hs,
> build/objects/HOC/Arguments.o )
> [ 6 of 18] Compiling HOC.Utilities ( ./HOC/Utilities.hs,
> build/objects/HOC/Utilities.o )
> [ 7 of 18] Compiling HOC.Invocation ( ./HOC/Invocation.hs,
> build/objects/HOC/Invocation.o )
> ...
A patch that does this is attached; I'll commit this soon if there are
no objections.
Cheers,
Wolfgang
Index: ghc/compiler/main/DriverPipeline.hs
===================================================================
RCS file: /home/cvs/root/fptools/ghc/compiler/main/DriverPipeline.hs,v
retrieving revision 1.197
diff -u -r1.197 DriverPipeline.hs
--- ghc/compiler/main/DriverPipeline.hs 5 Apr 2005 09:06:37 -0000 1.197
+++ ghc/compiler/main/DriverPipeline.hs 12 Apr 2005 20:40:24 -0000
@@ -92,6 +92,7 @@
-> ModSummary
-> Maybe Linkable -- Just linkable <=> source unchanged
-> Maybe ModIface -- Old interface, if available
+ -> Int -> Int
-> IO CompResult
data CompResult
@@ -102,7 +103,7 @@
| CompErrs
-compile hsc_env mod_summary maybe_old_linkable old_iface = do
+compile hsc_env mod_summary maybe_old_linkable old_iface mod_index
nmods = do
let dflags0 = hsc_dflags hsc_env
this_mod = ms_mod mod_summary
@@ -159,6 +160,7 @@
-- run the compiler
hsc_result <- hscMain hsc_env' printErrorsAndWarnings mod_summary
source_unchanged have_object old_iface
+ (Just (mod_index, nmods))
case hsc_result of
HscFail -> return CompErrs
@@ -701,6 +703,7 @@
mod_summary source_unchanged
False -- No object file
Nothing -- No iface
+ Nothing -- No "module i of n" progress
info
case result of
Index: ghc/compiler/main/GHC.hs
===================================================================
RCS file: /home/cvs/root/fptools/ghc/compiler/main/GHC.hs,v
retrieving revision 1.13
diff -u -r1.13 GHC.hs
--- ghc/compiler/main/GHC.hs 12 Apr 2005 16:49:31 -0000 1.13
+++ ghc/compiler/main/GHC.hs 12 Apr 2005 20:40:25 -0000
@@ -802,22 +802,25 @@
HscEnv, -- With an updated HPT
[ModSummary]) -- Mods which succeeded
-upsweep hsc_env old_hpt stable_mods cleanup
- []
+upsweep hsc_env old_hpt stable_mods cleanup mods
+ = upsweep' hsc_env old_hpt stable_mods cleanup mods 1 (length mods)
+
+upsweep' hsc_env old_hpt stable_mods cleanup
+ [] _ _
= return (Succeeded, hsc_env, [])
upsweep hsc_env old_hpt stable_mods cleanup
- (CyclicSCC ms:_)
+ (CyclicSCC ms:_) _ _
= do putMsg (showSDoc (cyclicModuleErr ms))
return (Failed, hsc_env, [])
-upsweep hsc_env old_hpt stable_mods cleanup
- (AcyclicSCC mod:mods)
+upsweep' hsc_env old_hpt stable_mods cleanup
+ (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 mod
+ mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod
+ mod_index nmods
cleanup -- Remove unwanted tmp files between compilations
@@ -841,7 +844,8 @@
| otherwise = delModuleEnv old_hpt this_mod
; (restOK, hsc_env2, modOKs)
- <- upsweep hsc_env1 old_hpt1 stable_mods cleanup mods
+ <- upsweep' hsc_env1 old_hpt1 stable_mods cleanup mods
+ (mod_index+1) nmods
; return (restOK, hsc_env2, mod:modOKs)
}
@@ -852,9 +856,11 @@
-> HomePackageTable
-> ([Module],[Module])
-> 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) summary
+upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index
nmods
= do
let
this_mod = ms_mod summary
@@ -864,6 +870,7 @@
compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
compile_it = upsweep_compile hsc_env old_hpt this_mod summary
+ mod_index nmods
case ghcMode (hsc_dflags hsc_env) of
BatchCompile ->
@@ -916,7 +923,9 @@
old_hmi = lookupModuleEnv old_hpt this_mod
-- Run hsc to compile a module
-upsweep_compile hsc_env old_hpt this_mod summary mb_old_linkable = do
+upsweep_compile hsc_env old_hpt this_mod 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
@@ -937,6 +946,7 @@
iface = hm_iface hm_info
compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
+ mod_index nmods
case compresult of
-- Compilation failed. Compile may still have updated the
PCS, tho.
Index: ghc/compiler/main/HscMain.lhs
===================================================================
RCS file: /home/cvs/root/fptools/ghc/compiler/main/HscMain.lhs,v
retrieving revision 1.212
diff -u -r1.212 HscMain.lhs
--- ghc/compiler/main/HscMain.lhs 8 Apr 2005 14:51:48 -0000 1.212
+++ ghc/compiler/main/HscMain.lhs 12 Apr 2005 20:40:25 -0000
@@ -164,10 +164,12 @@
-> 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" #-}
@@ -180,6 +182,7 @@
; what_next hsc_env msg_act mod_summary have_object
maybe_checked_iface
+ mb_mod_index
}
@@ -187,6 +190,7 @@
-- 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) $
@@ -198,7 +202,8 @@
}
| 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 ;
@@ -210,13 +215,14 @@
------------------------------
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
@@ -244,7 +250,7 @@
}}
-hscFileFrontEnd hsc_env msg_act mod_summary = do {
+hscFileFrontEnd hsc_env msg_act mod_summary mb_mod_index = do {
-------------------
-- DISPLAY PROGRESS MESSAGE
-------------------
@@ -253,7 +259,8 @@
; 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
@@ -788,3 +795,19 @@
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}
+
More information about the Cvs-ghc
mailing list