Commit 383016b8 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Add dump flag for timing output

This allows you to use `-ddump-to-file -ddump-timings` for more useful
dump output.

Test Plan: Try it

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D4195
parent 1aba27a3
...@@ -392,6 +392,7 @@ data DumpFlag ...@@ -392,6 +392,7 @@ data DumpFlag
| Opt_D_dump_hi_diffs | Opt_D_dump_hi_diffs
| Opt_D_dump_mod_cycles | Opt_D_dump_mod_cycles
| Opt_D_dump_mod_map | Opt_D_dump_mod_map
| Opt_D_dump_timings
| Opt_D_dump_view_pattern_commoning | Opt_D_dump_view_pattern_commoning
| Opt_D_verbose_core2core | Opt_D_verbose_core2core
| Opt_D_dump_debug | Opt_D_dump_debug
...@@ -3081,6 +3082,8 @@ dynamic_flags_deps = [ ...@@ -3081,6 +3082,8 @@ dynamic_flags_deps = [
(setDumpFlag Opt_D_dump_mod_cycles) (setDumpFlag Opt_D_dump_mod_cycles)
, make_ord_flag defGhcFlag "ddump-mod-map" , make_ord_flag defGhcFlag "ddump-mod-map"
(setDumpFlag Opt_D_dump_mod_map) (setDumpFlag Opt_D_dump_mod_map)
, make_ord_flag defGhcFlag "ddump-timings"
(setDumpFlag Opt_D_dump_timings)
, make_ord_flag defGhcFlag "ddump-view-pattern-commoning" , make_ord_flag defGhcFlag "ddump-view-pattern-commoning"
(setDumpFlag Opt_D_dump_view_pattern_commoning) (setDumpFlag Opt_D_dump_view_pattern_commoning)
, make_ord_flag defGhcFlag "ddump-to-file" , make_ord_flag defGhcFlag "ddump-to-file"
......
...@@ -614,7 +614,7 @@ withTiming :: MonadIO m ...@@ -614,7 +614,7 @@ withTiming :: MonadIO m
-> m a -> m a
withTiming getDFlags what force_result action withTiming getDFlags what force_result action
= do dflags <- getDFlags = do dflags <- getDFlags
if verbosity dflags >= 2 if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags
then do liftIO $ logInfo dflags (defaultUserStyle dflags) then do liftIO $ logInfo dflags (defaultUserStyle dflags)
$ text "***" <+> what <> colon $ text "***" <+> what <> colon
alloc0 <- liftIO getAllocationCounter alloc0 <- liftIO getAllocationCounter
...@@ -625,14 +625,23 @@ withTiming getDFlags what force_result action ...@@ -625,14 +625,23 @@ withTiming getDFlags what force_result action
alloc1 <- liftIO getAllocationCounter alloc1 <- liftIO getAllocationCounter
-- recall that allocation counter counts down -- recall that allocation counter counts down
let alloc = alloc0 - alloc1 let alloc = alloc0 - alloc1
liftIO $ logInfo dflags (defaultUserStyle dflags) time = realToFrac (end - start) * 1e-9
(text "!!!" <+> what <> colon <+> text "finished in"
<+> doublePrec 2 (realToFrac (end - start) * 1e-9) when (verbosity dflags >= 2)
<+> text "milliseconds" $ liftIO $ logInfo dflags (defaultUserStyle dflags)
<> comma (text "!!!" <+> what <> colon <+> text "finished in"
<+> text "allocated" <+> doublePrec 2 time
<+> doublePrec 3 (realToFrac alloc / 1024 / 1024) <+> text "milliseconds"
<+> text "megabytes") <> comma
<+> text "allocated"
<+> doublePrec 3 (realToFrac alloc / 1024 / 1024)
<+> text "megabytes")
liftIO $ dumpIfSet_dyn dflags Opt_D_dump_timings ""
$ hsep [ what <> colon
, text "alloc=" <> ppr alloc
, text "time=" <> doublePrec 3 time
]
pure r pure r
else action else action
......
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