summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLemmih <lemmih@gmail.com>2006-04-06 11:22:20 +0000
committerLemmih <lemmih@gmail.com>2006-04-06 11:22:20 +0000
commitd7d596d039b48dec6b71df9c4bca0d12958ecdb9 (patch)
tree8ae8233daf68cd425b5826e4298c0307ab1d6005
parent4ae1107dd5a839496cdb385daf14afee8360352c (diff)
downloadhaskell-d7d596d039b48dec6b71df9c4bca0d12958ecdb9.tar.gz
Better messages from HscTypes.showModMsg.
-rw-r--r--ghc/compiler/main/DriverPipeline.hs3
-rw-r--r--ghc/compiler/main/GHC.hs2
-rw-r--r--ghc/compiler/main/HscMain.lhs12
-rw-r--r--ghc/compiler/main/HscTypes.lhs13
4 files changed, 17 insertions, 13 deletions
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index ac98eff593..e20bc56940 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 b2c86df782..3f91af6cc4 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 3af61b11fb..e170f8fa31 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 2f2888db82..ee5438b319 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