Overhaul codebase to compile with ghc-events 0.5

Author: Mikolaj

Events/EventDuration.hs

@@ -10,8 +10,8 @@ module Events.EventDuration (
   ) where
 
 -- Imports for GHC Events
+import GHC.RTS.Events hiding (Event, GCIdle, GCWork)
 import qualified GHC.RTS.Events as GHC
-import GHC.RTS.Events hiding (Event,GCWork,GCIdle)
 
 -------------------------------------------------------------------------------
 -- This datastructure is a duration-based representation of the event
@@ -86,23 +86,23 @@ durationOf ed = endTimeOf ed - startTimeOf ed
 eventsToDurations :: [GHC.Event] -> [EventDuration]
 eventsToDurations [] = []
 eventsToDurations (event : events) =
-  case spec event of
+  case evSpec event of
      RunThread{thread=t} -> runDuration t : rest
      StopThread{}  -> rest
-     StartGC       -> gcStart (time event) events
+     StartGC       -> gcStart (evTime event) events
      EndGC{}       -> rest
      _otherEvent   -> rest
   where
     rest = eventsToDurations events
 
-    runDuration t = ThreadRun t s (time event) endTime
+    runDuration t = ThreadRun t s (evTime event) endTime
        where (endTime, s) = case findRunThreadTime events of
                               Nothing -> error $ "findRunThreadTime for " ++ (show event)
                               Just x -> x
 
 isDiscreteEvent :: GHC.Event -> Bool
 isDiscreteEvent e =
-  case spec e of
+  case evSpec e of
     RunThread{}  -> False
     StopThread{} -> False
     StartGC{}    -> False
@@ -116,62 +116,62 @@ isDiscreteEvent e =
 gcStart :: Timestamp -> [GHC.Event] -> [EventDuration]
 gcStart _  [] = []
 gcStart t0 (event : events) =
-  case spec event of
+  case evSpec event of
     GHC.GCWork{} -> GCStart t0 t1 : gcWork t1 events
     GHC.GCIdle{} -> GCStart t0 t1 : gcIdle t1 events
     GHC.GCDone{} -> GCStart t0 t1 : gcDone t1 events
     GHC.EndGC{}  -> GCStart t0 t1 : eventsToDurations events
     RunThread{}  -> GCStart t0 t1 : eventsToDurations (event : events)
     _other       -> gcStart t0 events
  where
-        t1 = time event
+        t1 = evTime event
 
 gcWork :: Timestamp -> [GHC.Event] -> [EventDuration]
 gcWork _  [] = []
 gcWork t0 (event : events) =
-  case spec event of
+  case evSpec event of
     GHC.GCWork{} -> gcWork t0 events
     GHC.GCIdle{} -> GCWork t0 t1 : gcIdle t1 events
     GHC.GCDone{} -> GCWork t0 t1 : gcDone t1 events
     GHC.EndGC{}  -> GCWork t0 t1 : eventsToDurations events
     RunThread{}  -> GCWork t0 t1 : eventsToDurations (event : events)
     _other       -> gcStart t0 events
  where
-        t1 = time event
+        t1 = evTime event
 
 gcIdle :: Timestamp -> [GHC.Event] -> [EventDuration]
 gcIdle _  [] = []
 gcIdle t0 (event : events) =
-  case spec event of
+  case evSpec event of
     GHC.GCIdle{} -> gcIdle t0 events
     GHC.GCWork{} -> GCIdle t0 t1 : gcWork t1 events
     GHC.GCDone{} -> GCIdle t0 t1 : gcDone t1 events
     GHC.EndGC{}  -> GCIdle t0 t1 : eventsToDurations events
     RunThread{}  -> GCIdle t0 t1 : eventsToDurations (event : events)
     _other       -> gcStart t0 events
  where
-        t1 = time event
+        t1 = evTime event
 
 gcDone :: Timestamp -> [GHC.Event] -> [EventDuration]
 gcDone _  [] = []
 gcDone t0 (event : events) =
-  case spec event of
+  case evSpec event of
     GHC.GCDone{} -> gcDone t0 events
     GHC.GCWork{} -> GCEnd t0 t1 : gcWork t1 events
     GHC.GCIdle{} -> GCEnd t0 t1 : gcIdle t1 events
     GHC.EndGC{}  -> GCEnd t0 t1 : eventsToDurations events
     RunThread{}  -> GCEnd t0 t1 : eventsToDurations (event : events)
     _other       -> gcStart t0 events
  where
-        t1 = time event
+        t1 = evTime event
 
 -------------------------------------------------------------------------------
 
 findRunThreadTime :: [GHC.Event] -> Maybe (Timestamp, ThreadStopStatus)
 findRunThreadTime [] = Nothing
 findRunThreadTime (e : es)
-  = case spec e of
-      StopThread{status=s} -> Just (time e, s)
+  = case evSpec e of
+      StopThread{status=s} -> Just (evTime e, s)
       _                    -> findRunThreadTime es
 
 -------------------------------------------------------------------------------

Events/EventTree.hs

@@ -14,11 +14,11 @@ module Events.EventTree (
 
 import Events.EventDuration
 
-import qualified GHC.RTS.Events as GHC
 import GHC.RTS.Events hiding (Event)
+import qualified GHC.RTS.Events as GHC
 
-import Text.Printf
 import Control.Exception (assert)
+import Text.Printf
 
 -------------------------------------------------------------------------------
 
@@ -195,7 +195,7 @@ mkEventTree es endTime =
   tree
  where
   tree = splitEvents es endTime
-  (s,e) = if null es then (0,0) else (time (head es), endTime)
+  (s,e) = if null es then (0,0) else (evTime (head es), endTime)
 
 splitEvents :: [GHC.Event] -- events
             -> Timestamp       -- end time of last event in the list
@@ -223,14 +223,14 @@ splitEvents es !endTime
   | otherwise
   = -- trace (printf "len = %d, startTime = %d, endTime = %d, lhs_len = %d\n" len startTime endTime lhs_len) $
     assert (length lhs + length rhs == length es) $
-    EventSplit (time (head rhs))
+    EventSplit (evTime (head rhs))
                ltree
                rtree
     where
     -- | Integer division, rounding up.
     divUp :: Timestamp -> Timestamp -> Timestamp
     divUp n k = (n + k - 1) `div` k
-    startTime = time (head es)
+    startTime = evTime (head es)
     splitTime = startTime + (endTime - startTime) `divUp` 2
     duration  = endTime - startTime
 
@@ -257,7 +257,7 @@ splitEventList (e:es) acc !tsplit !tmax
   | otherwise
   = (reverse acc, tmax, e:es)
   where
-    t = time e
+    t = evTime e
 
 -------------------------------------------------------------------------------
 

Events/HECs.hs

@@ -2,7 +2,6 @@
 module Events.HECs (
     HECs(..),
     Event,
-    CapEvent,
     Timestamp,
 
     eventIndexToTimestamp,
@@ -26,7 +25,7 @@ import qualified Data.List as L
 data HECs = HECs {
        hecCount         :: Int,
        hecTrees         :: [(DurationTree, EventTree, SparkTree)],
-       hecEventArray    :: Array Int CapEvent,
+       hecEventArray    :: Array Int Event,
        hecLastEventTime :: Timestamp,
        maxSparkPool     :: Double,
        minXHistogram    :: Int,
@@ -40,7 +39,7 @@ data HECs = HECs {
 
 eventIndexToTimestamp :: HECs -> Int -> Timestamp
 eventIndexToTimestamp HECs{hecEventArray=arr} n =
-  time (ce_event (arr ! n))
+  evTime (arr ! n)
 
 timestampToEventIndex :: HECs -> Timestamp -> Int
 timestampToEventIndex HECs{hecEventArray=arr} ts =
@@ -49,17 +48,17 @@ timestampToEventIndex HECs{hecEventArray=arr} ts =
     (l,r) = bounds arr
 
     search !l !r
-      | (r - l) <= 1 = if ts > time (ce_event (arr!l)) then r else l
+      | (r - l) <= 1 = if ts > evTime (arr!l) then r else l
       | ts < tmid    = search l mid
       | otherwise    = search mid r
       where
         mid  = l + (r - l) `quot` 2
-        tmid = time (ce_event (arr!mid))
+        tmid = evTime (arr!mid)
 
 extractUserMarkers :: HECs -> [(Timestamp, String)]
 extractUserMarkers hecs =
   [ (ts, mark)
-  | CapEvent _ (Event ts (UserMarker mark)) <- elems (hecEventArray hecs) ]
+  | (Event ts (UserMarker mark) _) <- elems (hecEventArray hecs) ]
 
 -- | Sum durations in the same buckets to form a histogram.
 histogram :: [(Int, Timestamp)] -> [(Int, Timestamp)]

Events/ReadEvents.hs

@@ -2,34 +2,35 @@ module Events.ReadEvents (
     registerEventsFromFile, registerEventsFromTrace
   ) where
 
+import Events.EventDuration
 import Events.EventTree
+import Events.HECs (HECs (..), histogram)
 import Events.SparkTree
-import Events.HECs (HECs(..), histogram)
 import Events.TestEvents
-import Events.EventDuration
-import qualified GUI.ProgressView as ProgressView
 import GUI.ProgressView (ProgressView)
+import qualified GUI.ProgressView as ProgressView
 
-import GHC.RTS.Events -- hiding (Event)
+import GHC.RTS.Events
 
 import GHC.RTS.Events.Analysis
-import GHC.RTS.Events.Analysis.SparkThread
 import GHC.RTS.Events.Analysis.Capability
+import GHC.RTS.Events.Analysis.SparkThread
+import GHC.RTS.EventsIncremental
 
+import qualified Control.DeepSeq as DeepSeq
+import Control.Exception
+import Control.Monad
 import Data.Array
+import Data.Either
+import Data.Function
+import qualified Data.IntMap as IM
 import qualified Data.List as L
 import Data.Map (Map)
 import qualified Data.Map as M
-import qualified Data.IntMap as IM
-import Data.Set (Set)
 import Data.Maybe (catMaybes, fromMaybe)
-import Text.Printf
+import Data.Set (Set)
 import System.FilePath
-import Control.Monad
-import Control.Exception
-import qualified Control.DeepSeq as DeepSeq
-import Data.Function
-import Data.Either
+import Text.Printf
 
 -------------------------------------------------------------------------------
 -- import qualified GHC.RTS.Events as GHCEvents
@@ -51,14 +52,14 @@ import Data.Either
 
 -------------------------------------------------------------------------------
 
-rawEventsToHECs :: [CapEvent] -> Timestamp
+rawEventsToHECs :: [Event] -> Timestamp
                 -> [(Double, (DurationTree, EventTree, SparkTree))]
 rawEventsToHECs evs endTime
-  = map (\ cap -> toTree $ L.find ((Just cap ==) . ce_cap . head) heclists)
-      [0 .. maximum (0 : map (fromMaybe 0 . ce_cap) evs)]
+  = map (\cap -> toTree $ L.find ((Just cap ==) . evCap . head) heclists)
+      [0 .. maximum (0 : map (fromMaybe 0 . evCap) evs)]
   where
     heclists =
-      L.groupBy ((==) `on` ce_cap) $ L.sortBy (compare `on` ce_cap) evs
+      L.groupBy ((==) `on` evCap) $ L.sortBy (compare `on` evCap) evs
 
     toTree Nothing    = (0, (DurationTreeEmpty,
                              EventTree 0 0 (EventTreeLeaf []),
@@ -68,8 +69,7 @@ rawEventsToHECs evs endTime
        (mkDurationTree (eventsToDurations nondiscrete) endTime,
         mkEventTree discrete endTime,
         mkSparkTree sparkD endTime))
-       where es = map ce_event evs
-             (discrete, nondiscrete) = L.partition isDiscreteEvent es
+       where (discrete, nondiscrete) = L.partition isDiscreteEvent evs
              (maxSparkPool, sparkD)  = eventsToSparkDurations nondiscrete
 
 -------------------------------------------------------------------------------
@@ -118,15 +118,10 @@ buildEventLog progress from =
   divUp n k = (n + k - 1) `div` k
   build name evs = do
     let
-      specBy1000 e@EventBlock{} =
-        e{end_time = end_time e `divUp` 1000,
-          block_events = map eBy1000 (block_events e)}
-      specBy1000 e = e
-      eBy1000 ev = ev{time = time ev `divUp` 1000,
-                      spec = specBy1000 (spec ev)}
+      eBy1000 ev = ev{evTime = evTime ev `divUp` 1000}
       eventsBy = map eBy1000 (events (dat evs))
-      eventBlockEnd e | EventBlock{ end_time=t } <- spec e = t
-      eventBlockEnd e = time e
+      eventBlockEnd e | EventBlock{ end_time=t } <- evSpec e = t
+      eventBlockEnd e = evTime e
 
       -- 1, to avoid graph scale 0 and division by 0 later on
       lastTx = maximum (1 : map eventBlockEnd eventsBy)
@@ -139,18 +134,18 @@ buildEventLog progress from =
       -- one more step in the 'perf to TS' workflow and is a bit slower
       -- (yet another event sorting and loading eventlog chunks
       -- into the CPU cache).
-      steps :: [CapEvent] -> [(Map KernelThreadId Int, CapEvent)]
+      steps :: [Event] -> [(Map KernelThreadId Int, Event)]
       steps evs =
         zip (map fst $ rights $ validates capabilityTaskOSMachine evs) evs
-      addC :: (Map KernelThreadId Int, CapEvent) -> CapEvent
-      addC (state, ev@CapEvent{ce_event=Event{spec=PerfTracepoint{tid}}}) =
+      addC :: (Map KernelThreadId Int, Event) -> Event
+      addC (state, ev@Event{evSpec=PerfTracepoint{tid}}) =
         case M.lookup tid state of
           Nothing -> ev  -- unknown task's OS thread
-          ce_cap  -> ev {ce_cap}
-      addC (state, ev@CapEvent{ce_event=Event{spec=PerfCounter{tid}}}) =
+          evCap  -> ev {evCap}
+      addC (state, ev@Event{evSpec=PerfCounter{tid}}) =
         case M.lookup tid state of
           Nothing -> ev  -- unknown task's OS thread
-          ce_cap  -> ev {ce_cap}
+          evCap  -> ev {evCap}
       addC (_, ev) = ev
       addCaps evs = map addC (steps evs)
 
@@ -183,13 +178,13 @@ buildEventLog progress from =
       sparkProfile :: Process
                         ((Map ThreadId (Profile SparkThreadState),
                           (Map Int ThreadId, Set ThreadId)),
-                         CapEvent)
+                         Event)
                         (ThreadId, (SparkThreadState, Timestamp, Timestamp))
       sparkProfile  = profileRouted
-                        (refineM (spec . ce_event) sparkThreadMachine)
+                        (refineM evSpec sparkThreadMachine)
                         capabilitySparkThreadMachine
                         capabilitySparkThreadIndexer
-                        (time . ce_event)
+                        evTime
                         sorted
 
       sparkSummary :: Map ThreadId (Int, Timestamp, Timestamp)
@@ -225,9 +220,7 @@ buildEventLog progress from =
       maxYHistogram = 10000 * ceiling (fromIntegral maxY / 10000)
 
       getPerfNames nmap ev =
-        case spec ev of
-          EventBlock{block_events} ->
-            L.foldl' getPerfNames nmap block_events
+        case evSpec ev of
           PerfName{perfNum, name} ->
             IM.insert (fromIntegral perfNum) name nmap
           _ -> nmap

Events/SparkTree.hs

@@ -9,8 +9,8 @@ module Events.SparkTree (
 
 import qualified Events.SparkStats as SparkStats
 
-import qualified GHC.RTS.Events as GHCEvents
 import GHC.RTS.Events (Timestamp)
+import qualified GHC.RTS.Events as GHCEvents
 
 import Control.Exception (assert)
 import Text.Printf
@@ -32,9 +32,9 @@ eventsToSparkDurations :: [GHCEvents.Event] -> (Double, [SparkDuration])
 eventsToSparkDurations es =
   let aux _startTime _startCounters [] = (0, [])
       aux startTime startCounters (event : events) =
-        case GHCEvents.spec event of
+        case GHCEvents.evSpec event of
           GHCEvents.SparkCounters crt dud ovf cnv fiz gcd rem ->
-            let endTime = GHCEvents.time event
+            let endTime = GHCEvents.evTime event
                 endCounters = (crt, dud, ovf, cnv, fiz, gcd, rem)
                 delta = SparkStats.create startCounters endCounters
                 newMaxSparkPool = SparkStats.maxPool delta