From: wolfgang Date: Wed, 13 Apr 2005 21:42:17 +0000 (+0000) Subject: [project @ 2005-04-13 21:42:17 by wolfgang] X-Git-Tag: Initial_conversion_from_CVS_complete~742 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=93cc7d223dd6e7a90927fc86fea562393c0d3820;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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} +