diff options
| author | Alp Mestanogullari <alpmestan@gmail.com> | 2019-09-07 10:51:47 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-09-19 21:42:17 -0400 |
| commit | b3e5c73119e5c3bf801885e56cababa446434211 (patch) | |
| tree | 52a6c4df29305d1f25bb762371f650496e85f00c /compiler/cmm | |
| parent | 521739900fe993ff73ec0da2215bc7572a15826d (diff) | |
| download | haskell-b3e5c73119e5c3bf801885e56cababa446434211.tar.gz | |
ErrUtils: split withTiming into withTiming and withTimingSilent
'withTiming' becomes a function that, when passed '-vN' (N >= 2) or
'-ddump-timings', will print timing (and possibly allocations) related
information. When additionally built with '-eventlog' and executed with
'+RTS -l', 'withTiming' will also emit both 'traceMarker' and 'traceEvent'
events to the eventlog.
'withTimingSilent' on the other hand will never print any timing information,
under any circumstance, and will only emit 'traceEvent' events to the eventlog.
As pointed out in !1672, 'traceMarker' is better suited for things that we
might want to visualize in tools like eventlog2html, while 'traceEvent'
is better suited for internal events that occur a lot more often and that we
don't necessarily want to visualize.
This addresses #17138 by using 'withTimingSilent' for all the codegen bits
that are expressed as a bunch of small computations over streams of codegen
ASTs.
Diffstat (limited to 'compiler/cmm')
| -rw-r--r-- | compiler/cmm/CmmInfo.hs | 5 | ||||
| -rw-r--r-- | compiler/cmm/CmmPipeline.hs | 2 |
2 files changed, 4 insertions, 3 deletions
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 60814f8039..82abbb62bd 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -48,7 +48,7 @@ import Hoopl.Collections import GHC.Platform import Maybes import DynFlags -import ErrUtils (withTiming) +import ErrUtils (withTimingSilent) import Panic import UniqSupply import MonadUtils @@ -74,7 +74,8 @@ cmmToRawCmm dflags cmms ; let do_one :: UniqSupply -> [CmmDecl] -> IO (UniqSupply, [RawCmmDecl]) do_one uniqs cmm = -- NB. strictness fixes a space leak. DO NOT REMOVE. - withTiming (return dflags) (text "Cmm -> Raw Cmm") forceRes $ + withTimingSilent (return dflags) (text "Cmm -> Raw Cmm") + forceRes $ case initUs uniqs $ concatMapM (mkInfoTable dflags) cmm of (b,uniqs') -> return (uniqs',b) ; return (snd <$> Stream.mapAccumL_ do_one uniqs cmms) diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 4ad93598aa..5ac3fddb3b 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -39,7 +39,7 @@ cmmPipeline -> CmmGroup -- Input C-- with Procedures -> IO (ModuleSRTInfo, CmmGroup) -- Output CPS transformed C-- -cmmPipeline hsc_env srtInfo prog = withTiming (return dflags) (text "Cmm pipeline") forceRes $ +cmmPipeline hsc_env srtInfo prog = withTimingSilent (return dflags) (text "Cmm pipeline") forceRes $ do let dflags = hsc_dflags hsc_env tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog |