[Git][ghc/ghc][wip/gc/progress-to-eventlog] 2 commits: ErrUtils: Emit progress messages to eventlog

[Ben Gamari]

Ben Gamari pushed to branch wip/gc/progress-to-eventlog at Glasgow Haskell Compiler / GHC


Commits:
2b199ee9 by Ben Gamari at 2019-04-16T19:18:10Z
ErrUtils: Emit progress messages to eventlog

- - - - -
91f1b03c by Ben Gamari at 2019-04-16T19:19:01Z
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
+                  traceEventIO $ showSDocOneLine dflags $ text "GHC started:" <+> what
                   alloc0 <- liftIO getAllocationCounter
                   start <- liftIO getCPUTime
                   !r <- action
                   () <- pure $ force_result r
+                  traceEventIO $ showSDocOneLine dflags $ text "GHC done:" <+> what
                   end <- liftIO getCPUTime
                   alloc1 <- liftIO getAllocationCounter
                   -- recall that allocation counter counts down



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/63db65b6895394a6fe9ff19bb08a7f3a3cc67d72...91f1b03cccfa4e14992cb5dbb2cf87a85a12bcb5

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/63db65b6895394a6fe9ff19bb08a7f3a3cc67d72...91f1b03cccfa4e14992cb5dbb2cf87a85a12bcb5
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/20190416/7764c18c/attachment-0001.html>