[Git][ghc/ghc][master] 2 commits: ErrUtils: Emit progress messages to eventlog

[Matthew Pickering]

Matthew Pickering pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
1bef62c3 by Ben Gamari at 2019-05-01T00:41:42Z
ErrUtils: Emit progress messages to eventlog

- - - - -
ebfa3528 by Ben Gamari at 2019-05-01T00:41:42Z
Emit GHC timing events to eventlog

- - - - -


1 changed file:

- compiler/main/ErrUtils.hs


Changes:

=====================================
compiler/main/ErrUtils.hs
=====================================
@@ -81,6 +81,7 @@ import Data.IORef
 import Data.Maybe       ( fromMaybe )
 import Data.Ord
 import Data.Time
+import Debug.Trace
 import Control.Monad
 import Control.Monad.IO.Class
 import System.IO
@@ -608,9 +609,10 @@ fatalErrorMsg'' :: FatalMessager -> String -> IO ()
 fatalErrorMsg'' fm msg = fm msg
 
 compilationProgressMsg :: DynFlags -> String -> IO ()
-compilationProgressMsg dflags msg
-  = ifVerbose dflags 1 $
-    logOutput dflags (defaultUserStyle dflags) (text msg)
+compilationProgressMsg dflags msg = do
+    traceEventIO $ "GHC progress: " ++ msg
+    ifVerbose dflags 1 $
+        logOutput dflags (defaultUserStyle dflags) (text msg)
 
 showPass :: DynFlags -> String -> IO ()
 showPass dflags what
@@ -651,10 +653,12 @@ withTiming getDFlags what force_result action
        if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags
           then do liftIO $ logInfo dflags (defaultUserStyle dflags)
                          $ text "***" <+> what <> colon
+                  liftIO $ traceEventIO $ showSDocOneLine dflags $ text "GHC:started:" <+> what
                   alloc0 <- liftIO getAllocationCounter
                   start <- liftIO getCPUTime
                   !r <- action
                   () <- pure $ force_result r
+                  liftIO $ traceEventIO $ showSDocOneLine dflags $ text "GHC:finished:" <+> what
                   end <- liftIO getCPUTime
                   alloc1 <- liftIO getAllocationCounter
                   -- recall that allocation counter counts down



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/37a4fd9715de4dad8033ea74483432c77818abf5...ebfa35284741fca47719f531f0996261441f75b0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/37a4fd9715de4dad8033ea74483432c77818abf5...ebfa35284741fca47719f531f0996261441f75b0
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/20190503/80db3e48/attachment-0001.html>