[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 )

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index a7aa2e1..c36e008 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -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
 

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index 5c8a5b8..fadcd2c 100644 (file)
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -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.

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 0c3e183..4d1fe47 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -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}
+