diff options
| -rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 58 | ||||
| -rw-r--r-- | compiler/GHC/Utils/Logger.hs | 15 |
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 = |