Commit e663f7b8 authored by simonmar's avatar simonmar

[project @ 2000-11-21 14:31:58 by simonmar]

Mostly verbosity changes.

GONE AWAY:  -dshow-passes, -ddump-all, -ddump-most.

NEW:
    -v<n>, where <n> is

    0	|   print errors & warnings only
    1   |   minimal verbosity: print "compiling M ... done." for each module.
    2   |   equivalent to -dshow-passes
    3   |   equivalent to existing "ghc -v"
    4   |   "ghc -v -ddump-most"
    5   |   "ghc -v -ddump-all"

4 & 5 are the same at the moment.  -dshow-passes also prints out the
passes in the driver, and some in the compilation manager.
parent 7d7d186e
......@@ -25,13 +25,16 @@ import CmStaticInfo ( GhciMode(..) )
import Outputable ( SDoc )
import Digraph ( SCC(..), flattenSCC )
import DriverUtil
import Module ( ModuleName, PackageName )
import Module ( ModuleName )
import RdrName
import FiniteMap
import Outputable
import ErrUtils ( showPass )
import CmdLineOpts ( DynFlags(..) )
import Panic ( panic )
import Exception
import Monad
import IO
#include "HsVersions.h"
......@@ -83,6 +86,7 @@ emptyPLS = return (PersistentLinkerState {})
\begin{code}
link :: GhciMode -- interactive or batch
-> DynFlags -- dynamic flags
-> Bool -- attempt linking in batch mode?
-> [Linkable] -- only contains LMs, not LPs
-> PersistentLinkerState
......@@ -107,30 +111,38 @@ link :: GhciMode -- interactive or batch
-- to be actually linked this time around (or unlinked and re-linked
-- if the module was recompiled).
link mode batch_attempt_linking linkables pls1
= do hPutStrLn stderr "CmLink.link: linkables are ..."
hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
res <- link' mode batch_attempt_linking linkables pls1
hPutStrLn stderr "CmLink.link: done"
link mode dflags batch_attempt_linking linkables pls1
= do let verb = verbosity dflags
when (verb >= 3) $ do
hPutStrLn stderr "CmLink.link: linkables are ..."
hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
res <- link' mode dflags batch_attempt_linking linkables pls1
when (verb >= 3) $
hPutStrLn stderr "CmLink.link: done"
return res
link' Batch batch_attempt_linking linkables pls1
link' Batch dflags batch_attempt_linking linkables pls1
| batch_attempt_linking
= do let o_files = concatMap getOfiles linkables
-- don't showPass in Batch mode; doLink will do that for us.
doLink o_files
-- doLink only returns if it succeeds
return (LinkOK pls1)
| otherwise
= do hPutStrLn stderr "CmLink.link(batch): upsweep (partially?) failed OR main not exported;"
hPutStrLn stderr " -- not doing linking"
= do let verb = verbosity dflags
when (verb >= 3) $ do
hPutStrLn stderr "CmLink.link(batch): upsweep (partially?) failed OR main not exported;"
hPutStrLn stderr "not linking."
return (LinkOK pls1)
where
getOfiles (LP _) = panic "CmLink.link(getOfiles): shouldn't get package linkables"
getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
link' Interactive batch_attempt_linking linkables pls1
= linkObjs linkables pls1
link' Interactive dflags batch_attempt_linking linkables pls1
= do showPass dflags "Linking"
pls2 <- unload pls1
linkObjs linkables pls2
ppLinkableSCC :: SCC Linkable -> SDoc
ppLinkableSCC = ppr . flattenSCC
......@@ -202,7 +214,6 @@ linkFinish pls mods ul_trees = do
closure_env = new_closure_env,
itbl_env = new_itbl_env
}
putStrLn (showSDoc (vcat (map ppr (keysFM new_closure_env))))
return (LinkOK new_pls)
-- purge the current "linked image"
......
......@@ -34,14 +34,16 @@ import UniqFM ( emptyUFM, lookupUFM, addToUFM, delListFromUFM,
UniqFM, listToUFM )
import Unique ( Uniquable )
import Digraph ( SCC(..), stronglyConnComp )
import DriverFlags ( getDynFlags )
import DriverPhases
import DriverUtil ( BarfKind(..), splitFilename3 )
import ErrUtils ( showPass )
import Util
import Outputable
import Panic ( panic )
#ifdef GHCI
import CmdLineOpts ( DynFlags )
import CmdLineOpts ( DynFlags(..) )
import Interpreter ( HValue )
import HscMain ( hscExpr )
import RdrName
......@@ -55,6 +57,7 @@ import Exception ( throwDyn )
import Time ( ClockTime )
import Directory ( getModificationTime, doesFileExist )
import IO
import Monad
import List ( nub )
import Maybe ( catMaybes, fromMaybe, isJust )
\end{code}
......@@ -175,7 +178,11 @@ cmLoadModule cmstate1 rootname
-- Throw away the old home dir cache
emptyHomeDirCache
hPutStrLn stderr ("ghc: chasing modules, starting from: " ++ rootname)
dflags <- getDynFlags
let verb = verbosity dflags
showPass dflags "Chasing dependencies"
mg2unsorted <- downsweep [rootname]
let modnames1 = map name_of_summary mg1
......@@ -225,10 +232,12 @@ cmLoadModule cmstate1 rootname
then
-- Easy; just relink it all.
do hPutStrLn stderr "UPSWEEP COMPLETELY SUCCESSFUL"
do when (verb >= 2) $
hPutStrLn stderr "Upsweep completely successful."
linkresult
<- link ghci_mode (any exports_main (moduleEnvElts hst3))
newLis pls1
<- link ghci_mode dflags
(any exports_main (moduleEnvElts hst3))
newLis pls1
case linkresult of
LinkErrs _ _
-> panic "cmLoadModule: link failed (1)"
......@@ -244,7 +253,8 @@ cmLoadModule cmstate1 rootname
-- Tricky. We need to back out the effects of compiling any
-- half-done cycles, both so as to clean up the top level envs
-- and to avoid telling the interactive linker to link them.
do hPutStrLn stderr "UPSWEEP PARTIALLY SUCCESSFUL"
do when (verb >= 2) $
hPutStrLn stderr "Upsweep partially successful."
let modsDone_names
= map name_of_summary modsDone
......@@ -262,7 +272,7 @@ cmLoadModule cmstate1 rootname
= map (unJust "linkables_to_link" . findModuleLinkable_maybe ui4)
mods_to_keep_names
linkresult <- link ghci_mode False linkables_to_link pls1
linkresult <- link ghci_mode dflags False linkables_to_link pls1
case linkresult of
LinkErrs _ _
-> panic "cmLoadModule: link failed (2)"
......@@ -342,7 +352,7 @@ upsweep_mods ghci_mode oldUI reachable_from threaded
upsweep_mods ghci_mode oldUI reachable_from threaded
((CyclicSCC ms):_)
= do hPutStrLn stderr ("ghc: module imports form a cycle for modules:\n\t" ++
= do hPutStrLn stderr ("Module imports form a cycle for modules:\n\t" ++
unwords (map (moduleNameUserString.name_of_summary) ms))
return (False, threaded, [], [])
......
......@@ -27,7 +27,7 @@ import VarSet
import Subst ( mkTyVarSubst, substTy )
import Name ( getSrcLoc )
import PprCore
import ErrUtils ( doIfSet_dyn, dumpIfSet, ghcExit, Message, showPass,
import ErrUtils ( doIfSet, dumpIfSet, ghcExit, Message, showPass,
ErrMsg, addErrLocHdrLine, pprBagOfErrors,
WarnMsg, pprBagOfWarnings)
import SrcLoc ( SrcLoc, noSrcLoc )
......@@ -72,7 +72,7 @@ endPassWithRules dflags pass_name dump_flag binds rules
-- Report result size if required
-- This has the side effect of forcing the intermediate to be evaluated
if dopt Opt_D_show_passes dflags then
if verbosity dflags >= 2 then
hPutStrLn stdout (" Result size = " ++ show (coreBindsSize binds))
else
return ()
......@@ -148,7 +148,7 @@ lintCoreBindings dflags whoDunnit binds
returnL ()
lint_bind (NonRec bndr rhs) = lintSingleBinding NonRecursive (bndr,rhs)
done_lint = doIfSet_dyn dflags Opt_D_show_passes
done_lint = doIfSet (verbosity dflags >= 2)
(hPutStr stdout ("*** Core Linted result of " ++ whoDunnit ++ "\n"))
warn warnings
= vcat [
......
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.7 2000/11/21 10:48:20 simonmar Exp $
-- $Id: InteractiveUI.hs,v 1.8 2000/11/21 14:32:44 simonmar Exp $
--
-- GHC Interactive User Interface
--
......@@ -82,7 +82,7 @@ interactiveUI st = do
Readline.initialize
#endif
_ <- (unGHCi uiLoop) GHCiState{ modules = [],
current_module = Nothing,
current_module = defaultCurrentModule,
target = Nothing,
cmstate = st }
return ()
......@@ -91,7 +91,7 @@ uiLoop :: GHCi ()
uiLoop = do
st <- getGHCiState
#ifndef NO_READLINE
l <- io (readline (mkPrompt (current_module st) ++ "> "))
l <- io (readline (moduleNameUserString (current_module st) ++ "> "))
#else
l <- io (hGetLine stdin)
#endif
......@@ -105,9 +105,6 @@ uiLoop = do
runCommand l
uiLoop
mkPrompt Nothing = ""
mkPrompt (Just mod_name) = moduleNameUserString mod_name
-- Top level exception handler, just prints out the exception
-- and carries on.
runCommand c =
......@@ -123,18 +120,15 @@ runCommand c =
doCommand c
doCommand (':' : command) = specialCommand command
doCommand expr = do
st <- getGHCiState
case current_module st of
Nothing -> throwDyn (OtherError "no module context in which to run the expression")
Just mod -> do
dflags <- io (readIORef v_DynFlags)
(new_cmstate, maybe_hvalue) <-
io (cmGetExpr (cmstate st) dflags mod expr)
setGHCiState st{cmstate = new_cmstate}
case maybe_hvalue of
Nothing -> return ()
Just hv -> io (cmRunExpr hv)
doCommand expr
= do st <- getGHCiState
dflags <- io (readIORef v_DynFlags)
(new_cmstate, maybe_hvalue) <-
io (cmGetExpr (cmstate st) dflags (current_module st) expr)
setGHCiState st{cmstate = new_cmstate}
case maybe_hvalue of
Nothing -> return ()
Just hv -> io (cmRunExpr hv)
{-
let (mod,'.':str) = break (=='.') expr
case cmLookupSymbol (mkOrig varName (mkModuleName mod) (_PK_ str)) (cmstate st) of
......@@ -175,8 +169,8 @@ loadModule path = do
cmstate = new_cmstate,
modules = mods,
current_module = case mods of
[] -> Nothing
xs -> Just (last xs),
[] -> defaultCurrentModule
xs -> last xs,
target = Just path
}
setGHCiState new_state
......@@ -236,11 +230,13 @@ shellEscape str = io (system str >> return ())
data GHCiState = GHCiState
{
modules :: [ModuleName],
current_module :: Maybe ModuleName,
current_module :: ModuleName,
target :: Maybe FilePath,
cmstate :: CmState
}
defaultCurrentModule = mkModuleName "Prelude"
newtype GHCi a = GHCi { unGHCi :: GHCiState -> IO (GHCiState, a) }
instance Monad GHCi where
......
......@@ -10,9 +10,11 @@ module CmdLineOpts (
SimplifierSwitch(..), isAmongSimpl,
StgToDo(..),
SwitchResult(..),
HscLang(..),
DynFlag(..), -- needed non-abstractly by DriverFlags
DynFlags(..),
defaultDynFlags,
v_Static_hsc_opts,
......@@ -214,9 +216,7 @@ data SimplifierSwitch
data DynFlag
-- debugging flags
= Opt_D_dump_all
| Opt_D_dump_most
| Opt_D_dump_absC
= Opt_D_dump_absC
| Opt_D_dump_asm
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
......@@ -239,7 +239,6 @@ data DynFlag
| Opt_D_dump_usagesp
| Opt_D_dump_cse
| Opt_D_dump_worker_wrapper
| Opt_D_show_passes
| Opt_D_dump_rn_trace
| Opt_D_dump_rn_stats
| Opt_D_dump_stix
......@@ -285,9 +284,27 @@ data DynFlags = DynFlags {
stgToDo :: [StgToDo],
hscLang :: HscLang,
hscOutName :: String, -- name of the file in which to place output
verbosity :: Int, -- verbosity level
flags :: [DynFlag]
}
defaultDynFlags = DynFlags {
coreToDo = [], stgToDo = [],
hscLang = HscC, hscOutName = "",
verbosity = 0, flags = []
}
{-
Verbosity levels:
0 | print errors & warnings only
1 | minimal verbosity: print "compiling M ... done." for each module.
2 | equivalent to -dshow-passes
3 | equivalent to existing "ghc -v"
4 | "ghc -v -ddump-most"
5 | "ghc -v -ddump-all"
-}
dopt :: DynFlag -> DynFlags -> Bool
dopt f dflags = f `elem` (flags dflags)
......
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.20 2000/11/19 19:40:08 simonmar Exp $
-- $Id: DriverFlags.hs,v 1.21 2000/11/21 14:34:29 simonmar Exp $
--
-- Driver flags
--
......@@ -22,6 +22,7 @@ import Util
import Exception
import IOExts
import IO
import Monad
import System
import Char
......@@ -152,7 +153,6 @@ static_flags =
exitWith ExitSuccess))
------- verbosity ----------------------------------------------------
, ( "v" , NoArg (writeIORef v_Verbose True) )
, ( "n" , NoArg (writeIORef v_Dry_run True) )
------- recompilation checker --------------------------------------
......@@ -295,16 +295,30 @@ static_flags =
-----------------------------------------------------------------------------
-- parse the dynamic arguments
GLOBAL_VAR(v_InitDynFlags, error "no InitDynFlags", DynFlags)
GLOBAL_VAR(v_DynFlags, error "no DynFlags", DynFlags)
-- v_InitDynFlags
-- is the "baseline" dynamic flags, initialised from
-- the defaults and command line options.
--
-- v_DynFlags
-- is the dynamic flags for the current compilation. It is reset
-- to the value of v_InitDynFlags before each compilation, then
-- updated by reading any OPTIONS pragma in the current module.
setDynFlag f = do
dfs <- readIORef v_DynFlags
writeIORef v_DynFlags dfs{ flags = f : flags dfs }
GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags)
unSetDynFlag f = do
updDynFlags f = do
dfs <- readIORef v_DynFlags
writeIORef v_DynFlags dfs{ flags = filter (/= f) (flags dfs) }
writeIORef v_DynFlags (f dfs)
getDynFlags :: IO DynFlags
getDynFlags = readIORef v_DynFlags
dynFlag :: (DynFlags -> a) -> IO a
dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
setDynFlag f = updDynFlags (\dfs -> dfs{ flags = f : flags dfs })
unSetDynFlag f = updDynFlags (\dfs -> dfs{ flags = filter (/= f) (flags dfs) })
-- we can only change HscC to HscAsm and vice-versa with dynamic flags
-- (-fvia-C and -fasm).
......@@ -315,11 +329,27 @@ setLang l = do
HscAsm -> writeIORef v_DynFlags dfs{ hscLang = l }
_ -> return ()
setVerbosityAtLeast n =
updDynFlags (\dfs -> if verbosity dfs < n
then dfs{ verbosity = n }
else dfs)
setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 2 })
setVerbosity n
| all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
| otherwise = throwDyn (OtherError "can't parse verbosity flag (-v<n>)")
getVerbFlag = do
verb <- dynFlag verbosity
if verb >= 3 then return "-v" else return ""
dynamic_flags = [
( "cpp", NoArg (updateState (\s -> s{ cpp_flag = True })) )
, ( "#include", HasArg (addCmdlineHCInclude) )
, ( "v", OptPrefix (setVerbosity) )
, ( "optL", HasArg (addOpt_L) )
, ( "optP", HasArg (addOpt_P) )
, ( "optc", HasArg (addOpt_c) )
......@@ -333,8 +363,6 @@ dynamic_flags = [
------ Debugging ----------------------------------------------------
, ( "dstg-stats", NoArg (writeIORef v_StgStats True) )
, ( "ddump-all", NoArg (setDynFlag Opt_D_dump_all) )
, ( "ddump-most", NoArg (setDynFlag Opt_D_dump_most) )
, ( "ddump-absC", NoArg (setDynFlag Opt_D_dump_absC) )
, ( "ddump-asm", NoArg (setDynFlag Opt_D_dump_asm) )
, ( "ddump-cpranal", NoArg (setDynFlag Opt_D_dump_cpranal) )
......@@ -358,7 +386,7 @@ dynamic_flags = [
, ( "ddump-usagesp", NoArg (setDynFlag Opt_D_dump_usagesp) )
, ( "ddump-cse", NoArg (setDynFlag Opt_D_dump_cse) )
, ( "ddump-worker-wrapper", NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
, ( "dshow-passes", NoArg (setDynFlag Opt_D_show_passes) )
, ( "dshow-passes", NoArg (setVerbosity "2") )
, ( "ddump-rn-trace", NoArg (setDynFlag Opt_D_dump_rn_trace) )
, ( "ddump-rn-stats", NoArg (setDynFlag Opt_D_dump_rn_stats) )
, ( "ddump-stix", NoArg (setDynFlag Opt_D_dump_stix) )
......@@ -470,3 +498,39 @@ buildStaticHscOpts = do
else return "")
return ( static : filtered_opts )
-----------------------------------------------------------------------------
-- Running an external program
-- sigh, here because both DriverMkDepend & DriverPipeline need it.
runSomething phase_name cmd
= do
verb <- dynFlag verbosity
when (verb >= 2) $ putStr ("*** " ++ phase_name)
when (verb >= 3) $ putStrLn cmd
hFlush stdout
-- test for -n flag
n <- readIORef v_Dry_run
unless n $ do
-- and run it!
#ifndef mingw32_TARGET_OS
exit_code <- system cmd `catchAllIO`
(\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
#else
tmp <- newTempName "sh"
h <- openFile tmp WriteMode
hPutStrLn h cmd
hClose h
exit_code <- system ("sh - " ++ tmp) `catchAllIO`
(\e -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
removeFile tmp
#endif
if exit_code /= ExitSuccess
then throwDyn (PhaseFailed phase_name exit_code)
else do when (verb >= 3) (putStr "\n")
return ()
-----------------------------------------------------------------------------
-- $Id: DriverMkDepend.hs,v 1.5 2000/11/15 15:43:31 sewardj Exp $
-- $Id: DriverMkDepend.hs,v 1.6 2000/11/21 14:34:47 simonmar Exp $
--
-- GHC Driver
--
......@@ -155,11 +155,11 @@ endMkDependHS = do
-- create a backup of the original makefile
when (isJust makefile_hdl) $
run_something ("Backing up " ++ makefile)
runSomething ("Backing up " ++ makefile)
(unwords [ "cp", makefile, makefile++".bak" ])
-- copy the new makefile in place
run_something "Installing new makefile"
runSomething "Installing new makefile"
(unwords [ "cp", tmp_file, makefile ])
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.33 2000/11/20 17:42:00 sewardj Exp $
-- $Id: DriverPipeline.hs,v 1.34 2000/11/21 14:34:50 simonmar Exp $
--
-- GHC Driver
--
......@@ -35,6 +35,7 @@ import TmpFiles
import HscTypes
import Outputable
import Module
import ErrUtils
import CmdLineOpts
import Config
import Util
......@@ -288,7 +289,7 @@ pipeLoop ((phase, keep, o_suffix):phases)
run_phase Unlit _basename _suff input_fn output_fn
= do unlit <- readIORef v_Pgm_L
unlit_flags <- getOpts opt_L
run_something "Literate pre-processor"
runSomething "Literate pre-processor"
("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
return True
......@@ -318,8 +319,9 @@ run_phase Cpp basename suff input_fn output_fn
let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
++ pkg_include_dirs)
verb <- is_verbose
run_something "C pre-processor"
verb <- getVerbFlag
runSomething "C pre-processor"
(unwords
(["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
cpp, verb]
......@@ -329,7 +331,7 @@ run_phase Cpp basename suff input_fn output_fn
++ [ "-x", "c", input_fn, ">>", output_fn ]
))
else do
run_something "Ineffective C pre-processor"
runSomething "Ineffective C pre-processor"
("echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}' > "
++ output_fn ++ " && cat " ++ input_fn
++ " >> " ++ output_fn)
......@@ -525,7 +527,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
mangle <- readIORef v_Do_asm_mangling
(md_c_flags, md_regd_c_flags) <- machdepCCOpts
verb <- is_verbose
verb <- getVerbFlag
o2 <- readIORef v_minus_o2_for_C
let opt_flag | o2 = "-O2"
......@@ -539,7 +541,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
excessPrecision <- readIORef v_Excess_precision
run_something "C Compiler"
runSomething "C Compiler"
(unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
++ md_c_flags
++ (if cc_phase == HCc && mangle
......@@ -572,7 +574,7 @@ run_phase Mangle _basename _suff input_fn output_fn
then do n_regs <- readState stolen_x86_regs
return [ show n_regs ]
else return []
run_something "Assembly Mangler"
runSomething "Assembly Mangler"
(unwords (mangler :
mangler_opts
++ [ input_fn, output_fn ]
......@@ -596,7 +598,7 @@ run_phase SplitMangle _basename _suff input_fn _output_fn
-- allocate a tmp file to put the no. of split .s files in (sigh)
n_files <- newTempName "n_files"
run_something "Split Assembly File"
runSomething "Split Assembly File"
(unwords [ splitter
, input_fn
, split_s_prefix
......@@ -618,7 +620,7 @@ run_phase As _basename _suff input_fn output_fn
cmdline_include_paths <- readIORef v_Include_paths
let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths
run_something "Assembler"
runSomething "Assembler"
(unwords (as : as_opts
++ cmdline_include_flags
++ [ "-c", input_fn, "-o", output_fn ]
......@@ -642,7 +644,7 @@ run_phase SplitAs basename _suff _input_fn _output_fn
let output_o = newdir real_odir
(basename ++ "__" ++ show n ++ ".o")
real_o <- osuf_ify output_o
run_something "Assembler"
runSomething "Assembler"
(unwords (as : as_opts
++ [ "-c", "-o", real_o, input_s ]
))
......@@ -656,7 +658,7 @@ run_phase SplitAs basename _suff _input_fn _output_fn
doLink :: [String] -> IO ()
doLink o_files = do
ln <- readIORef v_Pgm_l
verb <- is_verbose
verb <- getVerbFlag
static <- readIORef v_Static
let imp = if static then "" else "_imp"
no_hs_main <- readIORef v_NoHsMain
......@@ -695,7 +697,7 @@ doLink o_files = do
else []
#endif
(md_c_flags, _) <- machdepCCOpts
run_something "Linker"
runSomething "Linker"
(unwords
([ ln, verb, "-o", output_fn ]
++ md_c_flags
......@@ -770,21 +772,20 @@ data CompResult
compile ghci_mode summary source_unchanged old_iface hst hit pcs = do
verb <- readIORef v_Verbose
when verb (hPutStrLn stderr
(showSDoc (text "compile: compiling"
<+> ppr (name_of_summary summary))))
init_dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags init_dyn_flags
init_driver_state <- readIORef v_InitDriverState
writeIORef v_Driver_state init_driver_state
showPass init_dyn_flags (showSDoc (text "*** Compiling: "
<+> ppr (name_of_summary summary)))
let verb = verbosity init_dyn_flags
let location = ms_location summary
let input_fn = unJust "compile:hs" (ml_hs_file location)
let input_fnpp = unJust "compile:hspp" (ml_hspp_file location)