From d7d596d039b48dec6b71df9c4bca0d12958ecdb9 Mon Sep 17 00:00:00 2001 From: Lemmih Date: Thu, 6 Apr 2006 11:22:20 +0000 Subject: [PATCH] Better messages from HscTypes.showModMsg. --- ghc/compiler/main/DriverPipeline.hs | 3 ++- ghc/compiler/main/GHC.hs | 2 +- ghc/compiler/main/HscMain.lhs | 12 ++++++------ ghc/compiler/main/HscTypes.lhs | 13 ++++++++----- 4 files changed, 17 insertions(+), 13 deletions(-) diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index ac98eff..e20bc56 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -112,7 +112,8 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do | Just l <- maybe_old_linkable, isObjectLinkable l = True | otherwise = False - showPass dflags0 ("Compiling " ++ showModMsg have_object mod_summary) + -- FIXME: We need to know whether or not we're recompiling the file. Move this to HscMain? + --showPass dflags0 ("Compiling " ++ showModMsg have_object mod_summary) let location = ms_location mod_summary let input_fn = expectJust "compile:hs" (ml_hs_file location) diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs index b2c86df..3f91af6 100644 --- a/ghc/compiler/main/GHC.hs +++ b/ghc/compiler/main/GHC.hs @@ -2046,7 +2046,7 @@ showModule :: Session -> ModSummary -> IO String showModule s mod_summary = withSession s $ \hsc_env -> do case lookupModuleEnv (hsc_HPT hsc_env) (ms_mod mod_summary) of Nothing -> panic "missing linkable" - Just mod_info -> return (showModMsg obj_linkable mod_summary) + Just mod_info -> return (showModMsg (hscTarget (hsc_dflags hsc_env)) (not obj_linkable) mod_summary) where obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info)) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 3af61b1..e170f8f 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -293,7 +293,7 @@ hscCompileOneShot hsc_env mod_summary = hscCompileBatch :: Compiler (HscStatus, ModIface, ModDetails) hscCompileBatch hsc_env mod_summary = compiler hsc_env mod_summary - where mkComp = hscMkCompiler norecompBatch (batchMsg False) + where mkComp = hscMkCompiler norecompBatch batchMsg nonBootComp inp = hscSimplify inp >>= hscNormalIface >>= hscWriteIface >>= hscBatch bootComp inp = hscSimpleIface inp >>= hscWriteIface >>= hscNothing @@ -311,7 +311,7 @@ hscCompileBatch hsc_env mod_summary hscCompileNothing :: Compiler (HscStatus, ModIface, ModDetails) hscCompileNothing hsc_env mod_summary = compiler hsc_env mod_summary - where mkComp = hscMkCompiler norecompBatch (batchMsg False) + where mkComp = hscMkCompiler norecompBatch batchMsg pipeline inp = hscSimpleIface inp >>= hscIgnoreIface >>= hscNothing compiler = case ms_hsc_src mod_summary of @@ -325,7 +325,7 @@ hscCompileNothing hsc_env mod_summary -- Compile Haskell, extCore to bytecode. hscCompileInteractive :: Compiler (InteractiveStatus, ModIface, ModDetails) hscCompileInteractive hsc_env mod_summary = - hscMkCompiler norecompInteractive (batchMsg True) + hscMkCompiler norecompInteractive batchMsg frontend backend hsc_env mod_summary where backend inp = hscSimplify inp >>= hscNormalIface >>= hscIgnoreIface >>= hscInteractive @@ -377,13 +377,13 @@ oneShotMsg _mb_mod_index recomp else compilationProgressMsg (hsc_dflags hsc_env) $ "compilation IS NOT required" -batchMsg :: Bool -> Maybe (Int,Int) -> Bool -> Comp () -batchMsg toInterp mb_mod_index recomp +batchMsg :: Maybe (Int,Int) -> Bool -> Comp () +batchMsg mb_mod_index recomp = do hsc_env <- gets compHscEnv mod_summary <- gets compModSummary let showMsg msg = compilationProgressMsg (hsc_dflags hsc_env) $ (showModuleIndex mb_mod_index ++ - msg ++ showModMsg (not toInterp) mod_summary) + msg ++ showModMsg (hscTarget (hsc_dflags hsc_env)) recomp mod_summary) liftIO $ do if recomp then showMsg "Compiling " diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 2f2888d..ee5438b 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -86,7 +86,7 @@ import TyCon ( TyCon, tyConSelIds, tyConDataCons ) import DataCon ( dataConImplicitIds ) import PrelNames ( gHC_PRIM ) import Packages ( PackageIdH, PackageId, PackageConfig, HomeModules ) -import DynFlags ( DynFlags(..), isOneShot ) +import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) ) import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) import BasicTypes ( Version, initialVersion, IPName, Fixity, defaultFixity, DeprecTxt ) @@ -997,12 +997,15 @@ instance Outputable ModSummary where char '}' ] -showModMsg :: Bool -> ModSummary -> String -showModMsg use_object mod_summary +showModMsg :: HscTarget -> Bool -> ModSummary -> String +showModMsg target recomp mod_summary = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '), char '(', text (msHsFilePath mod_summary) <> comma, - if use_object then text (msObjFilePath mod_summary) - else text "interpreted", + case target of + HscInterpreted | recomp + -> text "interpreted" + HscNothing -> text "nothing" + _other -> text (msObjFilePath mod_summary), char ')']) where mod = ms_mod mod_summary -- 1.7.10.4