never executed always true always false
    1 {-# LANGUAGE BangPatterns    #-}
    2 {-# LANGUAGE RankNTypes      #-}
    3 {-# LANGUAGE ViewPatterns    #-}
    4 
    5 {-
    6 (c) The AQUA Project, Glasgow University, 1994-1998
    7 
    8 \section[ErrsUtils]{Utilities for error reporting}
    9 -}
   10 
   11 module GHC.Utils.Error (
   12         -- * Basic types
   13         Validity'(..), Validity, andValid, allValid, isValid, getInvalids, orValid,
   14         Severity(..),
   15 
   16         -- * Messages
   17         Diagnostic(..),
   18         MsgEnvelope(..),
   19         MessageClass(..),
   20         SDoc,
   21         DecoratedSDoc(unDecorated),
   22         Messages,
   23         mkMessages, unionMessages,
   24         errorsFound, isEmptyMessages,
   25 
   26         -- ** Formatting
   27         pprMessageBag, pprMsgEnvelopeBagWithLoc,
   28         pprMessages,
   29         pprLocMsgEnvelope,
   30         formatBulleted,
   31 
   32         -- ** Construction
   33         DiagOpts (..), diag_wopt, diag_fatal_wopt,
   34         emptyMessages, mkDecorated, mkLocMessage, mkLocMessageAnn,
   35         mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
   36         mkErrorMsgEnvelope,
   37         mkMCDiagnostic, errorDiagnostic, diagReasonSeverity,
   38 
   39         mkPlainError,
   40         mkPlainDiagnostic,
   41         mkDecoratedError,
   42         mkDecoratedDiagnostic,
   43         noHints,
   44 
   45         -- * Utilities
   46         getCaretDiagnostic,
   47 
   48         -- * Issuing messages during compilation
   49         putMsg, printInfoForUser, printOutputForUser,
   50         logInfo, logOutput,
   51         errorMsg,
   52         fatalErrorMsg,
   53         compilationProgressMsg,
   54         showPass,
   55         withTiming, withTimingSilent,
   56         debugTraceMsg,
   57         ghcExit,
   58         prettyPrintGhcErrors,
   59         traceCmd,
   60 
   61         sortMsgBag
   62     ) where
   63 
   64 import GHC.Prelude
   65 
   66 import GHC.Driver.Flags
   67 
   68 import GHC.Data.Bag
   69 import qualified GHC.Data.EnumSet as EnumSet
   70 import GHC.Data.EnumSet (EnumSet)
   71 
   72 import GHC.Utils.Exception
   73 import GHC.Utils.Outputable as Outputable
   74 import GHC.Utils.Panic
   75 import GHC.Utils.Panic.Plain
   76 import GHC.Utils.Logger
   77 import GHC.Types.Error
   78 import GHC.Types.SrcLoc as SrcLoc
   79 
   80 import System.Exit      ( ExitCode(..), exitWith )
   81 import Data.List        ( sortBy )
   82 import Data.Function
   83 import Debug.Trace
   84 import Control.Monad
   85 import Control.Monad.IO.Class
   86 import Control.Monad.Catch as MC (handle)
   87 import GHC.Conc         ( getAllocationCounter )
   88 import System.CPUTime
   89 
   90 data DiagOpts = DiagOpts
   91   { diag_warning_flags       :: !(EnumSet WarningFlag) -- ^ Enabled warnings
   92   , diag_fatal_warning_flags :: !(EnumSet WarningFlag) -- ^ Fatal warnings
   93   , diag_warn_is_error       :: !Bool                  -- ^ Treat warnings as errors
   94   , diag_reverse_errors      :: !Bool                  -- ^ Reverse error reporting order
   95   , diag_max_errors          :: !(Maybe Int)           -- ^ Max reported error count
   96   , diag_ppr_ctx             :: !SDocContext           -- ^ Error printing context
   97   }
   98 
   99 diag_wopt :: WarningFlag -> DiagOpts -> Bool
  100 diag_wopt wflag opts = wflag `EnumSet.member` diag_warning_flags opts
  101 
  102 diag_fatal_wopt :: WarningFlag -> DiagOpts -> Bool
  103 diag_fatal_wopt wflag opts = wflag `EnumSet.member` diag_fatal_warning_flags opts
  104 
  105 -- | Computes the /right/ 'Severity' for the input 'DiagnosticReason' out of
  106 -- the 'DiagOpts. This function /has/ to be called when a diagnostic is constructed,
  107 -- i.e. with a 'DiagOpts \"snapshot\" taken as close as possible to where a
  108 -- particular diagnostic message is built, otherwise the computed 'Severity' might
  109 -- not be correct, due to the mutable nature of the 'DynFlags' in GHC.
  110 diagReasonSeverity :: DiagOpts -> DiagnosticReason -> Severity
  111 diagReasonSeverity opts reason = case reason of
  112   WarningWithFlag wflag
  113     | not (diag_wopt wflag opts) -> SevIgnore
  114     | diag_fatal_wopt wflag opts -> SevError
  115     | otherwise                  -> SevWarning
  116   WarningWithoutFlag
  117     | diag_warn_is_error opts -> SevError
  118     | otherwise             -> SevWarning
  119   ErrorWithoutFlag
  120     -> SevError
  121 
  122 
  123 -- | Make a 'MessageClass' for a given 'DiagnosticReason', consulting the
  124 -- 'DiagOpts.
  125 mkMCDiagnostic :: DiagOpts -> DiagnosticReason -> MessageClass
  126 mkMCDiagnostic opts reason = MCDiagnostic (diagReasonSeverity opts reason) reason
  127 
  128 -- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the
  129 -- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag'.
  130 errorDiagnostic :: MessageClass
  131 errorDiagnostic = MCDiagnostic SevError ErrorWithoutFlag
  132 
  133 --
  134 -- Creating MsgEnvelope(s)
  135 --
  136 
  137 mk_msg_envelope
  138   :: Diagnostic e
  139   => Severity
  140   -> SrcSpan
  141   -> PrintUnqualified
  142   -> e
  143   -> MsgEnvelope e
  144 mk_msg_envelope severity locn print_unqual err
  145  = MsgEnvelope { errMsgSpan = locn
  146                , errMsgContext = print_unqual
  147                , errMsgDiagnostic = err
  148                , errMsgSeverity = severity
  149                }
  150 
  151 -- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location.
  152 -- If you know your 'Diagnostic' is an error, consider using 'mkErrorMsgEnvelope',
  153 -- which does not require looking at the 'DiagOpts'
  154 mkMsgEnvelope
  155   :: Diagnostic e
  156   => DiagOpts
  157   -> SrcSpan
  158   -> PrintUnqualified
  159   -> e
  160   -> MsgEnvelope e
  161 mkMsgEnvelope opts locn print_unqual err
  162  = mk_msg_envelope (diagReasonSeverity opts (diagnosticReason err)) locn print_unqual err
  163 
  164 -- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location.
  165 -- Precondition: the diagnostic is, in fact, an error. That is,
  166 -- @diagnosticReason msg == ErrorWithoutFlag@.
  167 mkErrorMsgEnvelope :: Diagnostic e
  168                    => SrcSpan
  169                    -> PrintUnqualified
  170                    -> e
  171                    -> MsgEnvelope e
  172 mkErrorMsgEnvelope locn unqual msg =
  173  assert (diagnosticReason msg == ErrorWithoutFlag) $ mk_msg_envelope SevError locn unqual msg
  174 
  175 -- | Variant that doesn't care about qualified/unqualified names.
  176 mkPlainMsgEnvelope :: Diagnostic e
  177                    => DiagOpts
  178                    -> SrcSpan
  179                    -> e
  180                    -> MsgEnvelope e
  181 mkPlainMsgEnvelope opts locn msg =
  182   mkMsgEnvelope opts locn alwaysQualify msg
  183 
  184 -- | Variant of 'mkPlainMsgEnvelope' which can be used when we are /sure/ we
  185 -- are constructing a diagnostic with a 'ErrorWithoutFlag' reason.
  186 mkPlainErrorMsgEnvelope :: Diagnostic e
  187                         => SrcSpan
  188                         -> e
  189                         -> MsgEnvelope e
  190 mkPlainErrorMsgEnvelope locn msg =
  191   mk_msg_envelope SevError locn alwaysQualify msg
  192 
  193 -------------------------
  194 data Validity' a
  195   = IsValid      -- ^ Everything is fine
  196   | NotValid a   -- ^ A problem, and some indication of why
  197 
  198 -- | Monomorphic version of @Validity'@ specialised for 'SDoc's.
  199 type Validity = Validity' SDoc
  200 
  201 isValid :: Validity' a -> Bool
  202 isValid IsValid       = True
  203 isValid (NotValid {}) = False
  204 
  205 andValid :: Validity' a -> Validity' a -> Validity' a
  206 andValid IsValid v = v
  207 andValid v _       = v
  208 
  209 -- | If they aren't all valid, return the first
  210 allValid :: [Validity' a] -> Validity' a
  211 allValid []       = IsValid
  212 allValid (v : vs) = v `andValid` allValid vs
  213 
  214 getInvalids :: [Validity' a] -> [a]
  215 getInvalids vs = [d | NotValid d <- vs]
  216 
  217 orValid :: Validity' a -> Validity' a -> Validity' a
  218 orValid IsValid _ = IsValid
  219 orValid _       v = v
  220 
  221 -- -----------------------------------------------------------------------------
  222 -- Collecting up messages for later ordering and printing.
  223 
  224 ----------------
  225 -- | Formats the input list of structured document, where each element of the list gets a bullet.
  226 formatBulleted :: SDocContext -> DecoratedSDoc -> SDoc
  227 formatBulleted ctx (unDecorated -> docs)
  228   = case msgs of
  229         []    -> Outputable.empty
  230         [msg] -> msg
  231         _     -> vcat $ map starred msgs
  232     where
  233     msgs    = filter (not . Outputable.isEmpty ctx) docs
  234     starred = (bullet<+>)
  235 
  236 pprMessages :: Diagnostic e => Messages e -> SDoc
  237 pprMessages = vcat . pprMsgEnvelopeBagWithLoc . getMessages
  238 
  239 pprMsgEnvelopeBagWithLoc :: Diagnostic e => Bag (MsgEnvelope e) -> [SDoc]
  240 pprMsgEnvelopeBagWithLoc bag = [ pprLocMsgEnvelope item | item <- sortMsgBag Nothing bag ]
  241 
  242 pprLocMsgEnvelope :: Diagnostic e => MsgEnvelope e -> SDoc
  243 pprLocMsgEnvelope (MsgEnvelope { errMsgSpan      = s
  244                                , errMsgDiagnostic = e
  245                                , errMsgSeverity  = sev
  246                                , errMsgContext   = unqual })
  247   = sdocWithContext $ \ctx ->
  248     withErrStyle unqual $
  249       mkLocMessage (MCDiagnostic sev (diagnosticReason e)) s (formatBulleted ctx $ diagnosticMessage e)
  250 
  251 sortMsgBag :: Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e]
  252 sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList
  253   where
  254     cmp
  255       | Just opts <- mopts
  256       , diag_reverse_errors opts
  257       = SrcLoc.rightmost_smallest
  258       | otherwise
  259       = SrcLoc.leftmost_smallest
  260     maybeLimit
  261       | Just opts <- mopts
  262       , Just err_limit <- diag_max_errors opts
  263       = take err_limit
  264       | otherwise
  265       = id
  266 
  267 ghcExit :: Logger -> Int -> IO ()
  268 ghcExit logger val
  269   | val == 0  = exitWith ExitSuccess
  270   | otherwise = do errorMsg logger (text "\nCompilation had errors\n\n")
  271                    exitWith (ExitFailure val)
  272 
  273 -- -----------------------------------------------------------------------------
  274 -- Outputting messages from the compiler
  275 
  276 errorMsg :: Logger -> SDoc -> IO ()
  277 errorMsg logger msg
  278    = logMsg logger errorDiagnostic noSrcSpan $
  279      withPprStyle defaultErrStyle msg
  280 
  281 fatalErrorMsg :: Logger -> SDoc -> IO ()
  282 fatalErrorMsg logger msg =
  283     logMsg logger MCFatal noSrcSpan $ withPprStyle defaultErrStyle msg
  284 
  285 compilationProgressMsg :: Logger -> SDoc -> IO ()
  286 compilationProgressMsg logger msg = do
  287   let logflags = logFlags logger
  288   let str = renderWithContext (log_default_user_context logflags) (text "GHC progress: " <> msg)
  289   traceEventIO str
  290   when (logVerbAtLeast logger 1) $
  291     logOutput logger $ withPprStyle defaultUserStyle msg
  292 
  293 showPass :: Logger -> String -> IO ()
  294 showPass logger what =
  295   when (logVerbAtLeast logger 2) $
  296     logInfo logger $ withPprStyle defaultUserStyle (text "***" <+> text what <> colon)
  297 
  298 data PrintTimings = PrintTimings | DontPrintTimings
  299   deriving (Eq, Show)
  300 
  301 -- | Time a compilation phase.
  302 --
  303 -- When timings are enabled (e.g. with the @-v2@ flag), the allocations
  304 -- and CPU time used by the phase will be reported to stderr. Consider
  305 -- a typical usage:
  306 -- @withTiming getDynFlags (text "simplify") force PrintTimings pass@.
  307 -- When timings are enabled the following costs are included in the
  308 -- produced accounting,
  309 --
  310 --  - The cost of executing @pass@ to a result @r@ in WHNF
  311 --  - The cost of evaluating @force r@ to WHNF (e.g. @()@)
  312 --
  313 -- The choice of the @force@ function depends upon the amount of forcing
  314 -- desired; the goal here is to ensure that the cost of evaluating the result
  315 -- is, to the greatest extent possible, included in the accounting provided by
  316 -- 'withTiming'. Often the pass already sufficiently forces its result during
  317 -- construction; in this case @const ()@ is a reasonable choice.
  318 -- In other cases, it is necessary to evaluate the result to normal form, in
  319 -- which case something like @Control.DeepSeq.rnf@ is appropriate.
  320 --
  321 -- To avoid adversely affecting compiler performance when timings are not
  322 -- requested, the result is only forced when timings are enabled.
  323 --
  324 -- See Note [withTiming] for more.
  325 withTiming :: MonadIO m
  326            => Logger
  327            -> SDoc         -- ^ The name of the phase
  328            -> (a -> ())    -- ^ A function to force the result
  329                            -- (often either @const ()@ or 'rnf')
  330            -> m a          -- ^ The body of the phase to be timed
  331            -> m a
  332 withTiming logger what force action =
  333   withTiming' logger what force PrintTimings action
  334 
  335 -- | Same as 'withTiming', but doesn't print timings in the
  336 --   console (when given @-vN@, @N >= 2@ or @-ddump-timings@).
  337 --
  338 --   See Note [withTiming] for more.
  339 withTimingSilent
  340   :: MonadIO m
  341   => Logger
  342   -> SDoc       -- ^ The name of the phase
  343   -> (a -> ())  -- ^ A function to force the result
  344                 -- (often either @const ()@ or 'rnf')
  345   -> m a        -- ^ The body of the phase to be timed
  346   -> m a
  347 withTimingSilent logger what force action =
  348   withTiming' logger what force DontPrintTimings action
  349 
  350 -- | Worker for 'withTiming' and 'withTimingSilent'.
  351 withTiming' :: MonadIO m
  352             => Logger
  353             -> SDoc         -- ^ The name of the phase
  354             -> (a -> ())    -- ^ A function to force the result
  355                             -- (often either @const ()@ or 'rnf')
  356             -> PrintTimings -- ^ Whether to print the timings
  357             -> m a          -- ^ The body of the phase to be timed
  358             -> m a
  359 withTiming' logger what force_result prtimings action
  360   = if logVerbAtLeast logger 2 || logHasDumpFlag logger Opt_D_dump_timings
  361     then do whenPrintTimings $
  362               logInfo logger $ withPprStyle defaultUserStyle $
  363                 text "***" <+> what <> colon
  364             let ctx = log_default_user_context (logFlags logger)
  365             alloc0 <- liftIO getAllocationCounter
  366             start <- liftIO getCPUTime
  367             eventBegins ctx what
  368             recordAllocs alloc0
  369             !r <- action
  370             () <- pure $ force_result r
  371             eventEnds ctx what
  372             end <- liftIO getCPUTime
  373             alloc1 <- liftIO getAllocationCounter
  374             recordAllocs alloc1
  375             -- recall that allocation counter counts down
  376             let alloc = alloc0 - alloc1
  377                 time = realToFrac (end - start) * 1e-9
  378 
  379             when (logVerbAtLeast logger 2 && prtimings == PrintTimings)
  380                 $ liftIO $ logInfo logger $ withPprStyle defaultUserStyle
  381                     (text "!!!" <+> what <> colon <+> text "finished in"
  382                      <+> doublePrec 2 time
  383                      <+> text "milliseconds"
  384                      <> comma
  385                      <+> text "allocated"
  386                      <+> doublePrec 3 (realToFrac alloc / 1024 / 1024)
  387                      <+> text "megabytes")
  388 
  389             whenPrintTimings $
  390                 putDumpFileMaybe logger Opt_D_dump_timings "" FormatText
  391                     $ text $ showSDocOneLine ctx
  392                     $ hsep [ what <> colon
  393                            , text "alloc=" <> ppr alloc
  394                            , text "time=" <> doublePrec 3 time
  395                            ]
  396             pure r
  397      else action
  398 
  399     where whenPrintTimings = liftIO . when (prtimings == PrintTimings)
  400 
  401           recordAllocs alloc =
  402             liftIO $ traceMarkerIO $ "GHC:allocs:" ++ show alloc
  403 
  404           eventBegins ctx w = do
  405             let doc = eventBeginsDoc ctx w
  406             whenPrintTimings $ traceMarkerIO doc
  407             liftIO $ traceEventIO doc
  408 
  409           eventEnds ctx w = do
  410             let doc = eventEndsDoc ctx w
  411             whenPrintTimings $ traceMarkerIO doc
  412             liftIO $ traceEventIO doc
  413 
  414           eventBeginsDoc ctx w = showSDocOneLine ctx $ text "GHC:started:" <+> w
  415           eventEndsDoc   ctx w = showSDocOneLine ctx $ text "GHC:finished:" <+> w
  416 
  417 debugTraceMsg :: Logger -> Int -> SDoc -> IO ()
  418 debugTraceMsg logger val msg =
  419    when (log_verbosity (logFlags logger) >= val) $
  420       logInfo logger (withPprStyle defaultDumpStyle msg)
  421 {-# INLINE debugTraceMsg #-}  -- see Note [INLINE conditional tracing utilities]
  422 
  423 putMsg :: Logger -> SDoc -> IO ()
  424 putMsg logger msg = logInfo logger (withPprStyle defaultUserStyle msg)
  425 
  426 printInfoForUser :: Logger -> PrintUnqualified -> SDoc -> IO ()
  427 printInfoForUser logger print_unqual msg
  428   = logInfo logger (withUserStyle print_unqual AllTheWay msg)
  429 
  430 printOutputForUser :: Logger -> PrintUnqualified -> SDoc -> IO ()
  431 printOutputForUser logger print_unqual msg
  432   = logOutput logger (withUserStyle print_unqual AllTheWay msg)
  433 
  434 logInfo :: Logger -> SDoc -> IO ()
  435 logInfo logger msg = logMsg logger MCInfo noSrcSpan msg
  436 
  437 -- | Like 'logInfo' but with 'SevOutput' rather then 'SevInfo'
  438 logOutput :: Logger -> SDoc -> IO ()
  439 logOutput logger msg = logMsg logger MCOutput noSrcSpan msg
  440 
  441 
  442 prettyPrintGhcErrors :: ExceptionMonad m => Logger -> m a -> m a
  443 prettyPrintGhcErrors logger = do
  444   let ctx = log_default_user_context (logFlags logger)
  445   MC.handle $ \e -> case e of
  446     PprPanic str doc ->
  447         pprDebugAndThen ctx panic (text str) doc
  448     PprSorry str doc ->
  449         pprDebugAndThen ctx sorry (text str) doc
  450     PprProgramError str doc ->
  451         pprDebugAndThen ctx pgmError (text str) doc
  452     _ -> liftIO $ throwIO e
  453 
  454 -- | Trace a command (when verbosity level >= 3)
  455 traceCmd :: Logger -> String -> String -> IO a -> IO a
  456 traceCmd logger phase_name cmd_line action = do
  457   showPass logger phase_name
  458   let
  459     cmd_doc = text cmd_line
  460     handle_exn exn = do
  461       debugTraceMsg logger 2 (char '\n')
  462       debugTraceMsg logger 2 (text "Failed:" <+> cmd_doc <+> text (show exn))
  463       throwGhcExceptionIO (ProgramError (show exn))
  464   debugTraceMsg logger 3 cmd_doc
  465   loggerTraceFlush logger
  466    -- And run it!
  467   action `catchIO` handle_exn
  468 
  469 {- Note [withTiming]
  470 ~~~~~~~~~~~~~~~~~~~~
  471 
  472 For reference:
  473 
  474   withTiming
  475     :: MonadIO
  476     => m DynFlags   -- how to get the DynFlags
  477     -> SDoc         -- label for the computation we're timing
  478     -> (a -> ())    -- how to evaluate the result
  479     -> PrintTimings -- whether to report the timings when passed
  480                     -- -v2 or -ddump-timings
  481     -> m a          -- computation we're timing
  482     -> m a
  483 
  484 withTiming lets you run an action while:
  485 
  486 (1) measuring the CPU time it took and reporting that on stderr
  487     (when PrintTimings is passed),
  488 (2) emitting start/stop events to GHC's event log, with the label
  489     given as an argument.
  490 
  491 Evaluation of the result
  492 ------------------------
  493 
  494 'withTiming' takes as an argument a function of type 'a -> ()', whose purpose is
  495 to evaluate the result "sufficiently". A given pass might return an 'm a' for
  496 some monad 'm' and result type 'a', but where the 'a' is complex enough
  497 that evaluating it to WHNF barely scratches its surface and leaves many
  498 complex and time-consuming computations unevaluated. Those would only be
  499 forced by the next pass, and the time needed to evaluate them would be
  500 mis-attributed to that next pass. A more appropriate function would be
  501 one that deeply evaluates the result, so as to assign the time spent doing it
  502 to the pass we're timing.
  503 
  504 Note: as hinted at above, the time spent evaluating the application of the
  505 forcing function to the result is included in the timings reported by
  506 'withTiming'.
  507 
  508 How we use it
  509 -------------
  510 
  511 We measure the time and allocations of various passes in GHC's pipeline by just
  512 wrapping the whole pass with 'withTiming'. This also materializes by having
  513 a label for each pass in the eventlog, where each pass is executed in one go,
  514 during a continuous time window.
  515 
  516 However, from STG onwards, the pipeline uses streams to emit groups of
  517 STG/Cmm/etc declarations one at a time, and process them until we get to
  518 assembly code generation. This means that the execution of those last few passes
  519 is interleaved and that we cannot measure how long they take by just wrapping
  520 the whole thing with 'withTiming'. Instead we wrap the processing of each
  521 individual stream element, all along the codegen pipeline, using the appropriate
  522 label for the pass to which this processing belongs. That generates a lot more
  523 data but allows us to get fine-grained timings about all the passes and we can
  524 easily compute totals with tools like ghc-events-analyze (see below).
  525 
  526 
  527 Producing an eventlog for GHC
  528 -----------------------------
  529 
  530 To actually produce the eventlog, you need an eventlog-capable GHC build:
  531 
  532   With Hadrian:
  533   $ hadrian/build -j "stage1.ghc-bin.ghc.link.opts += -eventlog"
  534 
  535   With Make:
  536   $ make -j GhcStage2HcOpts+=-eventlog
  537 
  538 You can then produce an eventlog when compiling say hello.hs by simply
  539 doing:
  540 
  541   If GHC was built by Hadrian:
  542   $ _build/stage1/bin/ghc -ddump-timings hello.hs -o hello +RTS -l
  543 
  544   If GHC was built with Make:
  545   $ inplace/bin/ghc-stage2 -ddump-timing hello.hs -o hello +RTS -l
  546 
  547 You could alternatively use -v<N> (with N >= 2) instead of -ddump-timings,
  548 to ask GHC to report timings (on stderr and the eventlog).
  549 
  550 This will write the eventlog to ./ghc.eventlog in both cases. You can then
  551 visualize it or look at the totals for each label by using ghc-events-analyze,
  552 threadscope or any other eventlog consumer. Illustrating with
  553 ghc-events-analyze:
  554 
  555   $ ghc-events-analyze --timed --timed-txt --totals \
  556                        --start "GHC:started:" --stop "GHC:finished:" \
  557                        ghc.eventlog
  558 
  559 This produces ghc.timed.txt (all event timestamps), ghc.timed.svg (visualisation
  560 of the execution through the various labels) and ghc.totals.txt (total time
  561 spent in each label).
  562 
  563 -}