Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
d7d596d0
Commit
d7d596d0
authored
Apr 06, 2006
by
David Himmelstrup
Browse files
Better messages from HscTypes.showModMsg.
parent
4ae1107d
Changes
4
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/main/DriverPipeline.hs
View file @
d7d596d0
...
...
@@ -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
)
...
...
ghc/compiler/main/GHC.hs
View file @
d7d596d0
...
...
@@ -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
))
...
...
ghc/compiler/main/HscMain.lhs
View file @
d7d596d0
...
...
@@ -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 "
...
...
ghc/compiler/main/HscTypes.lhs
View file @
d7d596d0
...
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment