Inline less logging codewip/spj-refactor-Jul21

When eyeballing calls of GHC.Core.Opt.Simplify.Monad.traceSmpl,
I saw that lots of cold-path logging code was getting inlined
into the main Simplifier module.

So in GHC.Utils.Logger I added a NOINLINE on logDumpFile'.

For logging, the "hot" path, up to and including the conditional,
should be inlined, but after that we should inline as little as
possible, to reduce code size in the caller.

2 files changed, 47 insertions, 26 deletions

diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index ea6b2f2ba5..3a38e56f6c 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -711,29 +711,41 @@ updTcRef ref fn = liftIO $ modifyIORef' ref fn
 ************************************************************************
 -}
 
--- Note [INLINE conditional tracing utilities]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~
--- 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. For
--- instance, instead of
---
---     let thunk = ...
---     in if doTracing
---          then emitTraceMsg thunk
---          else return ()
---
--- where the conditional is buried in a non-inlined utility function (e.g.
--- traceTc), we would rather have:
---
---     if doTracing
---       then let thunk = ...
---            in emitTraceMsg thunk
---       else return ()
---
--- See #18168.
---
+{- Note [INLINE conditional tracing utilities]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+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. For
+instance, if we don't inline traceTc, we'll get
+
+    let stuff_to_print = ...
+    in traceTc "wombat" stuff_to_print
+
+and the stuff_to_print thunk will be allocated in the "hot path", regardless
+of tracing.  But if we INLINE traceTc we get
+
+    let stuff_to_print = ...
+    in if doTracing
+         then emitTraceMsg "wombat" stuff_to_print
+         else return ()
+
+and then we float in:
+
+    if doTracing
+      then let stuff_to_print = ...
+           in emitTraceMsg "wombat" stuff_to_print
+      else return ()
+
+Now stuff_to_print is allocated only in the "cold path".
+
+Moreover, on the "cold" path, after the conditional, we want to inline
+as /little/ as possible.  Performance doesn't matter here, and we'd like
+to bloat the caller's code as little as possible.  So we put a NOINLINE
+on 'emitTraceMsg'
+
+See #18168.
+-}
 
 -- Typechecker trace
 traceTc :: String -> SDoc -> TcRn ()
diff --git a/compiler/GHC/Utils/Logger.hs b/compiler/GHC/Utils/Logger.hs
index e497b8c965..bf480b8394 100644
--- a/compiler/GHC/Utils/Logger.hs
+++ b/compiler/GHC/Utils/Logger.hs
@@ -577,11 +577,20 @@ putDumpFileMaybe'
     -> SDoc
     -> IO ()
 putDumpFileMaybe' logger printer flag hdr fmt doc
-  = when (logHasDumpFlag logger flag) $ do
-      let sty = mkDumpStyle printer
-      logDumpFile logger sty flag hdr fmt doc
+  = when (logHasDumpFlag logger flag) $
+    logDumpFile' logger printer flag hdr fmt doc
 {-# INLINE putDumpFileMaybe' #-}  -- see Note [INLINE conditional tracing utilities]
 
+
+logDumpFile' :: Logger -> PrintUnqualified -> DumpFlag
+             -> String -> DumpFormat -> SDoc -> IO ()
+{-# NOINLINE logDumpFile' #-}
+-- NOINLINE: Now we are past the conditional, into the "cold" path,
+--           don't inline, to reduce code size at the call site
+-- See Note [INLINE conditional tracing utilities]
+logDumpFile' logger printer flag hdr fmt doc
+  = logDumpFile logger (mkDumpStyle printer) flag hdr fmt doc
+
 -- | Ensure that a dump file is created even if it stays empty
 touchDumpFile :: Logger -> DumpFlag -> IO ()
 touchDumpFile logger flag =