Commit 8048d51b authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

ErrUtils: Add timings to compiler phases

This adds timings and allocation figures to the compiler's output when
run with `-v2` in an effort to ease performance analysis.

Todo:
  * Documentation
  * Where else should we add these?
  * Perhaps we should remove some of the now-arguably-redundant
    `showPass` occurrences where they are
  * Must we force more?
  * Perhaps we should place this behind a `-ftimings` instead of `-v2`

Test Plan: `ghc -v2 Test.hs`, look at the output

Reviewers: hvr, goldfire, simonmar, austin

Reviewed By: simonmar

Subscribers: angerman, michalt, niteria, ezyang, thomie

Differential Revision: https://phabricator.haskell.org/D1959
parent da3b29bd
......@@ -1375,8 +1375,7 @@ initEnv dflags = listToUFM [
]
parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe CmmGroup)
parseCmmFile dflags filename = do
showPass dflags "ParseCmm"
parseCmmFile dflags filename = withTiming (pure dflags) (text "ParseCmm"<+>brackets (text filename)) (\_ -> ()) $ do
buf <- hGetStringBuffer filename
let
init_loc = mkRealSrcLoc (mkFastString filename) 1 1
......
......@@ -14,7 +14,7 @@ module CoreLint (
lintAnnots,
-- ** Debug output
CoreLint.showPass, showPassIO, endPass, endPassIO,
endPass, endPassIO,
dumpPassResult,
CoreLint.dumpIfSet,
) where
......@@ -176,13 +176,6 @@ be, and it makes a conveneint place. place for them. They print out
stuff before and after core passes, and do Core Lint when necessary.
-}
showPass :: CoreToDo -> CoreM ()
showPass pass = do { dflags <- getDynFlags
; liftIO $ showPassIO dflags pass }
showPassIO :: DynFlags -> CoreToDo -> IO ()
showPassIO dflags pass = Err.showPass dflags (showPpr dflags pass)
endPass :: CoreToDo -> CoreProgram -> [CoreRule] -> CoreM ()
endPass pass binds rules
= do { hsc_env <- getHscEnv
......
......@@ -165,10 +165,12 @@ type CpeRhs = CoreExpr -- Non-terminal 'rhs'
************************************************************************
-}
corePrepPgm :: HscEnv -> ModLocation -> CoreProgram -> [TyCon] -> IO CoreProgram
corePrepPgm hsc_env mod_loc binds data_tycons = do
let dflags = hsc_dflags hsc_env
showPass dflags "CorePrep"
corePrepPgm :: HscEnv -> Module -> ModLocation -> CoreProgram -> [TyCon]
-> IO CoreProgram
corePrepPgm hsc_env this_mod mod_loc binds data_tycons =
withTiming (pure dflags)
(text "CorePrep"<+>brackets (ppr this_mod))
(const ()) $ do
us <- mkSplitUniqSupply 's'
initialCorePrepEnv <- mkInitialCorePrepEnv dflags hsc_env
......@@ -183,10 +185,12 @@ corePrepPgm hsc_env mod_loc binds data_tycons = do
endPassIO hsc_env alwaysQualify CorePrep binds_out []
return binds_out
where
dflags = hsc_dflags hsc_env
corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
corePrepExpr dflags hsc_env expr = do
showPass dflags "CorePrep"
corePrepExpr dflags hsc_env expr =
withTiming (pure dflags) (text "CorePrep [expr]") (const ()) $ do
us <- mkSplitUniqSupply 's'
initialCorePrepEnv <- mkInitialCorePrepEnv dflags hsc_env
let new_expr = initUs_ us (cpeBodyNF initialCorePrepEnv expr)
......
......@@ -291,9 +291,10 @@ deSugar hsc_env
= do { let dflags = hsc_dflags hsc_env
print_unqual = mkPrintUnqualified dflags rdr_env
; showPass dflags "Desugar"
-- Desugar the program
; withTiming (pure dflags)
(text "Desugar"<+>brackets (ppr mod))
(const ()) $
do { -- Desugar the program
; let export_set = availsToNameSet exports
target = hscTarget dflags
hpcInfo = emptyHpcInfo other_hpc_info
......@@ -391,7 +392,7 @@ deSugar hsc_env
mg_trust_pkg = imp_trust_own_pkg imports
}
; return (msgs, Just mod_guts)
}}}
}}}}
mkFileSrcSpan :: ModLocation -> SrcSpan
mkFileSrcSpan mod_loc
......
......@@ -74,9 +74,9 @@ byteCodeGen :: HscEnv
-> Maybe ModBreaks
-> IO CompiledByteCode
byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
= do let dflags = hsc_dflags hsc_env
showPass dflags "ByteCodeGen"
= withTiming (pure dflags)
(text "ByteCodeGen"<+>brackets (ppr this_mod))
(const ()) $ do
let flatBinds = [ (bndr, simpleFreeVars rhs)
| (bndr, rhs) <- flattenBinds binds]
......@@ -95,6 +95,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
(case modBreaks of
Nothing -> Nothing
Just mb -> Just mb{ modBreaks_breakInfo = breakInfo })
where dflags = hsc_dflags hsc_env
-- -----------------------------------------------------------------------------
-- Generating byte code for an expression
......@@ -105,9 +106,9 @@ coreExprToBCOs :: HscEnv
-> CoreExpr
-> IO UnlinkedBCO
coreExprToBCOs hsc_env this_mod expr
= do let dflags = hsc_dflags hsc_env
showPass dflags "ByteCodeGen"
= withTiming (pure dflags)
(text "ByteCodeGen"<+>brackets (ppr this_mod))
(const ()) $ do
-- create a totally bogus name for the top-level BCO; this
-- should be harmless, since it's never used for anything
let invented_name = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "ExprTopLevel")
......@@ -126,7 +127,7 @@ coreExprToBCOs hsc_env this_mod expr
dumpIfSet_dyn dflags Opt_D_dump_BCOs "Proto-BCOs" (ppr proto_bco)
assembleOneBCO hsc_env proto_bco
where dflags = hsc_dflags hsc_env
-- The regular freeVars function gives more information than is useful to
-- us here. simpleFreeVars does the impedence matching.
......
......@@ -42,7 +42,8 @@ llvmCodeGen :: DynFlags -> Handle -> UniqSupply
-> Stream.Stream IO RawCmmGroup ()
-> IO ()
llvmCodeGen dflags h us cmm_stream
= do bufh <- newBufHandle h
= withTiming (pure dflags) (text "LLVM CodeGen") (const ()) $ do
bufh <- newBufHandle h
-- Pass header
showPass dflags "LLVM CodeGen"
......
......@@ -13,7 +13,8 @@ module LlvmMangler ( llvmFixupAsm ) where
import DynFlags ( DynFlags, targetPlatform )
import Platform ( platformArch, Arch(..) )
import ErrUtils ( showPass )
import ErrUtils ( withTiming )
import Outputable ( text )
import Control.Exception
import qualified Data.ByteString.Char8 as B
......@@ -21,8 +22,8 @@ import System.IO
-- | Read in assembly file and process
llvmFixupAsm :: DynFlags -> FilePath -> FilePath -> IO ()
llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-} do
showPass dflags "LLVM Mangler"
llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-}
withTiming (pure dflags) (text "LLVM Mangler") id $
withBinaryFile f1 ReadMode $ \r -> withBinaryFile f2 WriteMode $ \w -> do
go r w
hClose r
......
......@@ -64,9 +64,10 @@ codeOutput dflags this_mod filenm location foreign_stubs pkg_deps cmm_stream
then Stream.mapM do_lint cmm_stream
else cmm_stream
do_lint cmm = do
{ showPass dflags "CmmLint"
; case cmmLint dflags cmm of
do_lint cmm = withTiming (pure dflags)
(text "CmmLint"<+>brackets (ppr this_mod))
(const ()) $ do
{ case cmmLint dflags cmm of
Just err -> do { log_action dflags
dflags
NoReason
......
......@@ -5,6 +5,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module ErrUtils (
-- * Basic types
......@@ -41,7 +42,7 @@ module ErrUtils (
errorMsg, warningMsg,
fatalErrorMsg, fatalErrorMsg', fatalErrorMsg'',
compilationProgressMsg,
showPass,
showPass, withTiming,
debugTraceMsg,
ghcExit,
prettyPrintGhcErrors,
......@@ -68,6 +69,8 @@ import Data.Time
import Control.Monad
import Control.Monad.IO.Class
import System.IO
import GHC.Conc ( getAllocationCounter )
import System.CPUTime
-------------------------
type MsgDoc = SDoc
......@@ -459,6 +462,59 @@ showPass dflags what
= ifVerbose dflags 2 $
logInfo dflags defaultUserStyle (text "***" <+> text what <> colon)
-- | Time a compilation phase.
--
-- When timings are enabled (e.g. with the @-v2@ flag), the allocations
-- and CPU time used by the phase will be reported to stderr. Consider
-- a typical usage: @withTiming getDynFlags (text "simplify") force pass@.
-- When timings are enabled the following costs are included in the
-- produced accounting,
--
-- - The cost of executing @pass@ to a result @r@ in WHNF
-- - The cost of evaluating @force r@ to WHNF (e.g. @()@)
--
-- The choice of the @force@ function depends upon the amount of forcing
-- desired; the goal here is to ensure that the cost of evaluating the result
-- is, to the greatest extent possible, included in the accounting provided by
-- 'withTiming'. Often the pass already sufficiently forces its result during
-- construction; in this case @const ()@ is a reasonable choice.
-- In other cases, it is necessary to evaluate the result to normal form, in
-- which case something like @Control.DeepSeq.rnf@ is appropriate.
--
-- To avoid adversely affecting compiler performance when timings are not
-- requested, the result is only forced when timings are enabled.
withTiming :: MonadIO m
=> m DynFlags -- ^ A means of getting a 'DynFlags' (often
-- 'getDynFlags' will work here)
-> SDoc -- ^ The name of the phase
-> (a -> ()) -- ^ A function to force the result
-- (often either @const ()@ or 'rnf')
-> m a -- ^ The body of the phase to be timed
-> m a
withTiming getDFlags what force_result action
= do dflags <- getDFlags
if verbosity dflags >= 2
then do liftIO $ logInfo dflags defaultUserStyle
$ text "***" <+> what <> colon
alloc0 <- liftIO getAllocationCounter
start <- liftIO getCPUTime
!r <- action
() <- pure $ force_result r
end <- liftIO getCPUTime
alloc1 <- liftIO getAllocationCounter
-- recall that allocation counter counts down
let alloc = alloc0 - alloc1
liftIO $ logInfo dflags defaultUserStyle
(text "!!!" <+> what <> colon <+> text "finished in"
<+> doublePrec 2 (realToFrac (end - start) * 1e-9)
<+> text "milliseconds"
<> comma
<+> text "allocated"
<+> doublePrec 3 (realToFrac alloc / 1024 / 1024)
<+> text "megabytes")
pure r
else action
debugTraceMsg :: DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg dflags val msg = ifVerbose dflags val $
logInfo dflags defaultDumpStyle msg
......
......@@ -114,15 +114,16 @@ depanal excluded_mods allow_dup_roots = do
targets = hsc_targets hsc_env
old_graph = hsc_mod_graph hsc_env
liftIO $ showPass dflags "Chasing dependencies"
liftIO $ debugTraceMsg dflags 2 (hcat [
text "Chasing modules from: ",
hcat (punctuate comma (map pprTarget targets))])
mod_graphE <- liftIO $ downsweep hsc_env old_graph excluded_mods allow_dup_roots
mod_graph <- reportImportErrors mod_graphE
modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
return mod_graph
withTiming (pure dflags) (text "Chasing dependencies") (const ()) $ do
liftIO $ debugTraceMsg dflags 2 (hcat [
text "Chasing modules from: ",
hcat (punctuate comma (map pprTarget targets))])
mod_graphE <- liftIO $ downsweep hsc_env old_graph
excluded_mods allow_dup_roots
mod_graph <- reportImportErrors mod_graphE
modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
return mod_graph
-- | Describes which modules of the module graph need to be loaded.
data LoadHowMuch
......
......@@ -339,15 +339,15 @@ hscParse hsc_env mod_summary = runHsc hsc_env $ hscParse' mod_summary
-- internal version, that doesn't fail due to -Werror
hscParse' :: ModSummary -> Hsc HsParsedModule
hscParse' mod_summary = do
hscParse' mod_summary = {-# SCC "Parser" #-}
withTiming getDynFlags
(text "Parser"<+>brackets (ppr $ ms_mod mod_summary))
(const ()) $ do
dflags <- getDynFlags
let src_filename = ms_hspp_file mod_summary
maybe_src_buf = ms_hspp_buf mod_summary
-------------------------- Parser ----------------
liftIO $ showPass dflags "Parser"
{-# SCC "Parser" #-} do
-- sometimes we already have the buffer in memory, perhaps
-- because we needed to parse the imports out of it, or get the
-- module name.
......@@ -1252,7 +1252,8 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do
-- PREPARE FOR CODE GENERATION
-- Do saturation and convert to A-normal form
prepd_binds <- {-# SCC "CorePrep" #-}
corePrepPgm hsc_env location core_binds data_tycons ;
corePrepPgm hsc_env this_mod location
core_binds data_tycons
----------------- Convert to STG ------------------
(stg_binds, cost_centre_info)
<- {-# SCC "CoreToStg" #-}
......@@ -1268,27 +1269,28 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do
-- top-level function, so showPass isn't very useful here.
-- Hence we have one showPass for the whole backend, the
-- next showPass after this will be "Assembler".
showPass dflags "CodeGen"
cmms <- {-# SCC "StgCmm" #-}
doCodeGen hsc_env this_mod data_tycons
cost_centre_info
stg_binds hpc_info
------------------ Code output -----------------------
rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
cmmToRawCmm dflags cmms
let dump a = do dumpIfSet_dyn dflags Opt_D_dump_cmm_raw "Raw Cmm"
(ppr a)
return a
rawcmms1 = Stream.mapM dump rawcmms0
(output_filename, (_stub_h_exists, stub_c_exists))
<- {-# SCC "codeOutput" #-}
codeOutput dflags this_mod output_filename location
foreign_stubs dependencies rawcmms1
return (output_filename, stub_c_exists)
withTiming (pure dflags)
(text "CodeGen"<+>brackets (ppr this_mod))
(const ()) $ do
cmms <- {-# SCC "StgCmm" #-}
doCodeGen hsc_env this_mod data_tycons
cost_centre_info
stg_binds hpc_info
------------------ Code output -----------------------
rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
cmmToRawCmm dflags cmms
let dump a = do dumpIfSet_dyn dflags Opt_D_dump_cmm_raw "Raw Cmm"
(ppr a)
return a
rawcmms1 = Stream.mapM dump rawcmms0
(output_filename, (_stub_h_exists, stub_c_exists))
<- {-# SCC "codeOutput" #-}
codeOutput dflags this_mod output_filename location
foreign_stubs dependencies rawcmms1
return (output_filename, stub_c_exists)
hscInteractive :: HscEnv
......@@ -1315,7 +1317,7 @@ hscInteractive hsc_env cgguts mod_summary = do
-- PREPARE FOR CODE GENERATION
-- Do saturation and convert to A-normal form
prepd_binds <- {-# SCC "CorePrep" #-}
corePrepPgm hsc_env location core_binds data_tycons
corePrepPgm hsc_env this_mod location core_binds data_tycons
----------------- Generate byte code ------------------
comp_bc <- byteCodeGen hsc_env this_mod prepd_binds data_tycons mod_breaks
------------------ Create f-x-dynamic C-side stuff ---
......@@ -1549,7 +1551,7 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
{- Prepare For Code Generation -}
-- Do saturation and convert to A-normal form
prepd_binds <- {-# SCC "CorePrep" #-}
liftIO $ corePrepPgm hsc_env iNTERACTIVELoc core_binds data_tycons
liftIO $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons
{- Generate byte code -}
cbc <- liftIO $ byteCodeGen hsc_env this_mod
......@@ -1659,9 +1661,10 @@ hscParseThing = hscParseThingWithLocation "<interactive>" 1
hscParseThingWithLocation :: (Outputable thing) => String -> Int
-> Lexer.P thing -> String -> Hsc thing
hscParseThingWithLocation source linenumber parser str
= {-# SCC "Parser" #-} do
= withTiming getDynFlags
(text "Parser [source]")
(const ()) $ {-# SCC "Parser" #-} do
dflags <- getDynFlags
liftIO $ showPass dflags "Parser"
let buf = stringToStringBuffer str
loc = mkRealSrcLoc (fsLit source) linenumber 1
......
......@@ -137,12 +137,15 @@ mkBootModDetailsTc hsc_env
tcg_tcs = tcs,
tcg_patsyns = pat_syns,
tcg_insts = insts,
tcg_fam_insts = fam_insts
tcg_fam_insts = fam_insts,
tcg_mod = this_mod
}
= do { let dflags = hsc_dflags hsc_env
; showPassIO dflags CoreTidy
; let { insts' = map (tidyClsInstDFun globaliseAndTidyId) insts
= -- This timing isn't terribly useful since the result isn't forced, but
-- the message is useful to locating oneself in the compilation process.
Err.withTiming (pure dflags)
(text "CoreTidy"<+>brackets (ppr this_mod))
(const ()) $
do { let { insts' = map (tidyClsInstDFun globaliseAndTidyId) insts
; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns
; type_env1 = mkBootTypeEnv (availsToNameSet exports)
(typeEnvIds type_env) tcs fam_insts
......@@ -160,6 +163,7 @@ mkBootModDetailsTc hsc_env
})
}
where
dflags = hsc_dflags hsc_env
mkBootTypeEnv :: NameSet -> [Id] -> [TyCon] -> [FamInst] -> TypeEnv
mkBootTypeEnv exports ids tcs fam_insts
......@@ -315,12 +319,13 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
, mg_modBreaks = modBreaks
})
= do { let { dflags = hsc_dflags hsc_env
; omit_prags = gopt Opt_OmitInterfacePragmas dflags
= Err.withTiming (pure dflags)
(text "CoreTidy"<+>brackets (ppr mod))
(const ()) $
do { let { omit_prags = gopt Opt_OmitInterfacePragmas dflags
; expose_all = gopt Opt_ExposeAllUnfoldings dflags
; print_unqual = mkPrintUnqualified dflags rdr_env
}
; showPassIO dflags CoreTidy
; let { type_env = typeEnvFromEntities [] tcs fam_insts
......@@ -414,6 +419,8 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
md_anns = anns -- are already tidy
})
}
where
dflags = hsc_dflags hsc_env
lookup_aux_id :: TypeEnv -> Var -> Id
lookup_aux_id type_env id
......
......@@ -21,7 +21,7 @@ import OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
import IdInfo
import CoreStats ( coreBindsSize, coreBindsStats, exprSize )
import CoreUtils ( mkTicks, stripTicksTop )
import CoreLint ( showPass, endPass, lintPassResult, dumpPassResult,
import CoreLint ( endPass, lintPassResult, dumpPassResult,
lintAnnots )
import Simplify ( simplTopBinds, simplExpr, simplRules )
import SimplUtils ( simplEnvForGHCi, activeRule )
......@@ -33,6 +33,7 @@ import FloatIn ( floatInwards )
import FloatOut ( floatOutwards )
import FamInstEnv
import Id
import ErrUtils ( withTiming )
import BasicTypes ( CompilerPhase(..), isDefaultInlinePragma )
import VarSet
import VarEnv
......@@ -357,11 +358,15 @@ runCorePasses passes guts
do_pass guts CoreDoNothing = return guts
do_pass guts (CoreDoPasses ps) = runCorePasses ps guts
do_pass guts pass
= do { showPass pass
; guts' <- lintAnnots (ppr pass) (doCorePass pass) guts
= withTiming getDynFlags
(ppr pass <+> brackets (ppr mod))
(const ()) $ do
{ guts' <- lintAnnots (ppr pass) (doCorePass pass) guts
; endPass pass (mg_binds guts') (mg_rules guts')
; return guts' }
mod = mg_module guts
doCorePass :: CoreToDo -> ModGuts -> CoreM ModGuts
doCorePass pass@(CoreDoSimplify {}) = {-# SCC "Simplify" #-}
simplifyPgm pass
......@@ -423,17 +428,18 @@ printCore dflags binds
= Err.dumpIfSet dflags True "Print Core" (pprCoreBindings binds)
ruleCheckPass :: CompilerPhase -> String -> ModGuts -> CoreM ModGuts
ruleCheckPass current_phase pat guts = do
rb <- getRuleBase
dflags <- getDynFlags
vis_orphs <- getVisibleOrphanMods
liftIO $ Err.showPass dflags "RuleCheck"
liftIO $ log_action dflags dflags NoReason Err.SevDump noSrcSpan
defaultDumpStyle
(ruleCheckProgram current_phase pat
(RuleEnv rb vis_orphs) (mg_binds guts))
return guts
ruleCheckPass current_phase pat guts =
withTiming getDynFlags
(text "RuleCheck"<+>brackets (ppr $ mg_module guts))
(const ()) $ do
{ rb <- getRuleBase
; dflags <- getDynFlags
; vis_orphs <- getVisibleOrphanMods
; liftIO $ log_action dflags dflags NoReason Err.SevDump noSrcSpan
defaultDumpStyle
(ruleCheckProgram current_phase pat
(RuleEnv rb vis_orphs) (mg_binds guts))
; return guts }
doPassDUM :: (DynFlags -> UniqSupply -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts
doPassDUM do_pass = doPassM $ \binds -> do
......@@ -501,9 +507,8 @@ simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
--
-- Also used by Template Haskell
simplifyExpr dflags expr
= do {
; Err.showPass dflags "Simplify"
= withTiming (pure dflags) (text "Simplify [expr]") (const ()) $
do {
; us <- mkSplitUniqSupply 's'
; let sz = exprSize expr
......
......@@ -131,16 +131,18 @@ tcRnModule :: HscEnv
tcRnModule hsc_env hsc_src save_rn_syntax
parsedModule@HsParsedModule {hpm_module=L loc this_module}
| RealSrcSpan real_loc <- loc
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
; initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $
withTcPlugins hsc_env $
tcRnModuleTcRnM hsc_env hsc_src parsedModule pair }
= withTiming (pure dflags)
(text "Renamer/typechecker"<+>brackets (ppr this_mod))
(const ()) $
initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $
withTcPlugins hsc_env $
tcRnModuleTcRnM hsc_env hsc_src parsedModule pair
| otherwise
= return ((emptyBag, unitBag err_msg), Nothing)
where
dflags = hsc_dflags hsc_env
err_msg = mkPlainErrMsg (hsc_dflags hsc_env) loc $
text "Module does not have a RealSrcSpan:" <+> ppr this_mod
......
......@@ -22,7 +22,7 @@ module Outputable (
empty, isEmpty, nest,
char,
text, ftext, ptext, ztext,
int, intWithCommas, integer, float, double, rational,
int, intWithCommas, integer, float, double, rational, doublePrec,
parens, cparen, brackets, braces, quotes, quote,
doubleQuotes, angleBrackets, paBrackets,
semi, comma, colon, dcolon, space, equals, dot, vbar,
......@@ -111,6 +111,7 @@ import Data.Word
import System.IO ( Handle )
import System.FilePath
import Text.Printf
import Numeric (showFFloat)
import Data.Graph (SCC(..))
import GHC.Fingerprint
......@@ -508,6 +509,11 @@ float n = docToSDoc $ Pretty.float n
double n = docToSDoc $ Pretty.double n
rational n = docToSDoc $ Pretty.rational n
-- | @doublePrec p n@ shows a floating point number @n@ with @p@
-- digits of precision after the decimal point.
doublePrec :: Int -> Double -> SDoc
doublePrec p n = text (showFFloat (Just p) n "")
parens, braces, brackets, quotes, quote,
paBrackets, doubleQuotes, angleBrackets :: SDoc -> SDoc
......
......@@ -201,7 +201,15 @@ Dumping out compiler intermediate structures
.. ghc-flag:: -dshow-passes
Print out each pass name as it happens.
Print out each pass name, its runtime and heap allocations as it happens.
Note that this may come at a slight performance cost as the compiler will
be a bit more eager in forcing pass results to more accurately account for
their costs.
Two types of messages are produced: Those beginning with ``***`` are
denote the beginning of a compilation phase whereas those starting with
``!!!`` mark the end of a pass and are accompanied by allocation and
runtime statistics.
.. ghc-flag:: -ddump-core-stats
......
......@@ -593,11 +593,11 @@ See also the ``--help``, ``--version``, ``--numeric-version``, and
``-v1``
Minimal verbosity: print one line per compilation (this is the
default when ``--make`` or ``--interactive`` is on).
default when :ghc-flag:`--make` or :ghc-flag:`--interactive` is on).
``-v2``
Print the name of each compilation phase as it is executed.
(equivalent to ``-dshow-passes``).
(equivalent to :ghc-flag:`-dshow-passes`).
``-v3``
The same as ``-v2``, except that in addition the full command
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment