Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
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
Supports
Markdown
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