[Git][ghc/ghc][wip/lower-tc-tracing-cost] typecheck: Avoid unnecessary tracing allocations

[Ben Gamari]

Ben Gamari pushed to branch wip/lower-tc-tracing-cost at Glasgow Haskell Compiler / GHC


Commits:
16c4bbf9 by Ben Gamari at 2020-04-14T01:16:08-04:00
typecheck: Avoid unnecessary tracing allocations

While ticky-profiling the typechecker I noticed that hundreds of
millions of SDocs are being allocated just in case -ddump-*-trace is
enabled. This is awful.

We avoid this by ensuring that the dump flag check is inlined into the
call site, ensuring that the tracing document needn't be allocated
unless it's actually needed.

- - - - -


1 changed file:

- compiler/GHC/Tc/Utils/Monad.hs


Changes:

=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -490,6 +490,7 @@ unsetWOptM flag =
 whenDOptM :: DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
 whenDOptM flag thing_inside = do b <- doptM flag
                                  when b thing_inside
+{-# INLINE whenDOptM #-} -- Note [INLINE trace{Tc,Rn}]
 
 whenGOptM :: GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
 whenGOptM flag thing_inside = do b <- goptM flag
@@ -665,39 +666,47 @@ updTcRef ref fn = liftIO $ do { old <- readIORef ref
 ************************************************************************
 -}
 
+-- Note [INLINE trace{Tc,Rn}]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- In general we want to optimise for the case where tracing is not enabled.
+-- To ensure this happens, we ensure that traceTc and friends are inlined; this
+-- ensures that the allocation of the document can be pushed into the tracing
+-- path, keeping the non-traced path free of this extraneous work.
 
 -- Typechecker trace
 traceTc :: String -> SDoc -> TcRn ()
-traceTc =
-  labelledTraceOptTcRn Opt_D_dump_tc_trace
+traceTc herald doc =
+    labelledTraceOptTcRn Opt_D_dump_tc_trace herald doc
+{-# INLINE traceTc #-} -- Note [INLINE trace{Tc,Rn}]
 
 -- Renamer Trace
 traceRn :: String -> SDoc -> TcRn ()
-traceRn =
-  labelledTraceOptTcRn Opt_D_dump_rn_trace
+traceRn herald doc =
+    labelledTraceOptTcRn Opt_D_dump_rn_trace herald doc
+{-# INLINE traceRn #-} -- Note [INLINE trace{Tc,Rn}]
 
 -- | Trace when a certain flag is enabled. This is like `traceOptTcRn`
 -- but accepts a string as a label and formats the trace message uniformly.
 labelledTraceOptTcRn :: DumpFlag -> String -> SDoc -> TcRn ()
-labelledTraceOptTcRn flag herald doc = do
-   traceOptTcRn flag (formatTraceMsg herald doc)
+labelledTraceOptTcRn flag herald doc =
+  traceOptTcRn flag (formatTraceMsg herald doc)
+{-# INLINE labelledOptTraceTcRn #-} -- Note [INLINE trace{Tc,Rn}]
 
 formatTraceMsg :: String -> SDoc -> SDoc
 formatTraceMsg herald doc = hang (text herald) 2 doc
 
--- | Trace if the given 'DumpFlag' is set.
 traceOptTcRn :: DumpFlag -> SDoc -> TcRn ()
 traceOptTcRn flag doc = do
-  dflags <- getDynFlags
-  when (dopt flag dflags) $
+  whenDOptM flag $
     dumpTcRn False (dumpOptionsFromFlag flag) "" FormatText doc
+{-# INLINE traceOptTcRn #-} -- Note [INLINE trace{Tc,Rn}]
 
 -- | Dump if the given 'DumpFlag' is set.
 dumpOptTcRn :: DumpFlag -> String -> DumpFormat -> SDoc -> TcRn ()
 dumpOptTcRn flag title fmt doc = do
-  dflags <- getDynFlags
-  when (dopt flag dflags) $
+  whenDOptM flag $
     dumpTcRn False (dumpOptionsFromFlag flag) title fmt doc
+{-# INLINE dumpOptTcRn #-} -- Note [INLINE trace{TcRn}]
 
 -- | Unconditionally dump some trace output
 --



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16c4bbf9bc36b247265029fb63afba28c7810835

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16c4bbf9bc36b247265029fb63afba28c7810835
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200414/4fd0314b/attachment-0001.html>