never executed always true always false

    1 -- | Tracing utilities
    2 module GHC.Utils.Trace
    3   ( pprTrace
    4   , pprTraceM
    5   , pprTraceDebug
    6   , pprTraceIt
    7   , pprSTrace
    8   , pprTraceException
    9   , warnPprTrace
   10   , pprTraceUserWarning
   11   , trace
   12   )
   13 where
   14 
   15 import GHC.Prelude
   16 import GHC.Utils.Outputable
   17 import GHC.Utils.Exception
   18 import GHC.Utils.Panic
   19 import GHC.Utils.GlobalVars
   20 import GHC.Utils.Constants
   21 import GHC.Stack
   22 
   23 import Debug.Trace (trace)
   24 import Control.Monad.IO.Class
   25 
   26 -- | If debug output is on, show some 'SDoc' on the screen
   27 pprTrace :: String -> SDoc -> a -> a
   28 pprTrace str doc x
   29   | unsafeHasNoDebugOutput = x
   30   | otherwise              = pprDebugAndThen defaultSDocContext trace (text str) doc x
   31 
   32 pprTraceM :: Applicative f => String -> SDoc -> f ()
   33 pprTraceM str doc = pprTrace str doc (pure ())
   34 
   35 pprTraceDebug :: String -> SDoc -> a -> a
   36 pprTraceDebug str doc x
   37    | debugIsOn && unsafeHasPprDebug = pprTrace str doc x
   38    | otherwise                      = x
   39 
   40 -- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x@.
   41 -- This allows you to print details from the returned value as well as from
   42 -- ambient variables.
   43 pprTraceWith :: String -> (a -> SDoc) -> a -> a
   44 pprTraceWith desc f x = pprTrace desc (f x) x
   45 
   46 -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@
   47 pprTraceIt :: Outputable a => String -> a -> a
   48 pprTraceIt desc x = pprTraceWith desc ppr x
   49 
   50 -- | @pprTraceException desc x action@ runs action, printing a message
   51 -- if it throws an exception.
   52 pprTraceException :: ExceptionMonad m => String -> SDoc -> m a -> m a
   53 pprTraceException heading doc =
   54     handleGhcException $ \exc -> liftIO $ do
   55         putStrLn $ renderWithContext defaultSDocContext
   56                  $ withPprStyle defaultDumpStyle
   57                  $ sep [text heading, nest 2 doc]
   58         throwGhcExceptionIO exc
   59 
   60 -- | If debug output is on, show some 'SDoc' on the screen along
   61 -- with a call stack when available.
   62 pprSTrace :: HasCallStack => SDoc -> a -> a
   63 pprSTrace doc = pprTrace "" (doc $$ traceCallStackDoc)
   64 
   65 -- | Just warn about an assertion failure, recording the given file and line number.
   66 warnPprTrace :: HasCallStack => Bool -> SDoc -> a -> a
   67 warnPprTrace _     _    x | not debugIsOn     = x
   68 warnPprTrace _     _msg x | unsafeHasNoDebugOutput = x
   69 warnPprTrace False _msg x = x
   70 warnPprTrace True   msg x
   71   = pprDebugAndThen defaultSDocContext trace (text "WARNING:")
   72                     (msg $$ withFrozenCallStack traceCallStackDoc )
   73                     x
   74 
   75 -- | For when we want to show the user a non-fatal WARNING so that they can
   76 -- report a GHC bug, but don't want to panic.
   77 pprTraceUserWarning :: HasCallStack => SDoc -> a -> a
   78 pprTraceUserWarning msg x
   79   | unsafeHasNoDebugOutput = x
   80   | otherwise = pprDebugAndThen defaultSDocContext trace (text "WARNING:")
   81                     (msg $$ withFrozenCallStack traceCallStackDoc )
   82                     x
   83 
   84 traceCallStackDoc :: HasCallStack => SDoc
   85 traceCallStackDoc =
   86     hang (text "Call stack:")
   87        4 (vcat $ map text $ lines (prettyCallStack callStack))