Better messages from HscTypes.showModMsg.

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