Refactor

GhcEvents.hs

@@ -3,7 +3,7 @@
 module Main where
 
 import GHC.RTS.Events
-import GHC.RTS.EventsIncremental
+import GHC.RTS.Events.Incremental
 import GHC.RTS.Events.Merge
 import GHC.RTS.Events.Analysis
 import GHC.RTS.Events.Analysis.SparkThread
@@ -22,15 +22,9 @@ main = getArgs >>= command
 command :: [String] -> IO ()
 command ["--help"] = putStr usage
 
-command ["inc", file] = do
-    h <- openBinaryFile file ReadMode
-    eh <- ehOpen h 4096
-    printEventsIncremental eh False
+command ["inc", file] = printEventsIncremental False file
 
-command ["inc", "force", file] = do
-    h <- openBinaryFile file ReadMode
-    eh <- ehOpen h 1024
-    printEventsIncremental eh True
+command ["inc", "force", file] = printEventsIncremental True file
 
 command ["show", file] = do
     evtLog <- readLogOrDie file

ghc-events.cabal

@@ -52,18 +52,20 @@ library
                     bytestring >= 0.10.4,
                     array      >= 0.2 && < 0.6
   exposed-modules:  GHC.RTS.Events,
-                    GHC.RTS.EventsIncremental
+                    GHC.RTS.Events.Incremental
                     GHC.RTS.Events.Merge
                     GHC.RTS.Events.Analysis
                     GHC.RTS.Events.Analysis.Capability
                     GHC.RTS.Events.Analysis.SparkThread
                     GHC.RTS.Events.Analysis.Thread
   other-modules:    GHC.RTS.EventParserUtils,
                     GHC.RTS.EventTypes
+                    GHC.RTS.Events.Binary
   hs-source-dirs:   src
   include-dirs:     include
   extensions:	    RecordWildCards, NamedFieldPuns, BangPatterns, PatternGuards
   other-extensions: FlexibleContexts, CPP
+  ghc-options:      -Wall
 
 executable ghc-events
   main-is:          GhcEvents.hs

src/GHC/RTS/EventParserUtils.hs

@@ -1,7 +1,5 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
-
 module GHC.RTS.EventParserUtils (
         EventParser(..),
         EventParsers(..),
@@ -46,7 +44,7 @@ skip n = G.skip (fromIntegral n)
 --
 
 --
--- Event parser data.  Parsers are either fixed or vairable size.
+-- | Event parser data. Parsers are either fixed or vairable size.
 --
 data EventParser a
     = FixedSizeParser {
@@ -168,7 +166,7 @@ padParser size (FixedSizeParser t orig_size orig_p) = FixedSizeParser t size p
 
 makeParserMap :: [EventParser a] -> IntMap [EventParser a]
 makeParserMap = foldl buildParserMap M.empty
-    where buildParserMap map' parser = 
+    where buildParserMap map' parser =
               M.alter (addParser parser) (getType parser) map'
           addParser p Nothing = Just [p]
           addParser p (Just ps) = Just (p:ps)

src/GHC/RTS/EventTypes.hs

@@ -1,6 +1,5 @@
-{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
-
 module GHC.RTS.EventTypes where
+import Control.Monad
 
 import Data.Binary
 
@@ -130,11 +129,11 @@ data Event =
 
 {-# DEPRECATED time "The field is now called evTime" #-}
 time :: Event -> Timestamp
-time = evTime 
+time = evTime
 
 {-# DEPRECATED spec "The field is now called evSpec" #-}
 spec :: Event -> EventInfo
-spec = evSpec 
+spec = evSpec
 
 data EventInfo
 
@@ -158,7 +157,7 @@ data EventInfo
   | RunThread          { thread :: {-# UNPACK #-}!ThreadId
                        }
   | StopThread         { thread :: {-# UNPACK #-}!ThreadId,
-                         status :: ThreadStopStatus
+                         status :: !ThreadStopStatus
                        }
   | ThreadRunnable     { thread :: {-# UNPACK #-}!ThreadId
                        }
@@ -471,7 +470,7 @@ mkStopStatus782 n = case n of
  19 ->  BlockedOnMsgGlobalise
  _  ->  error "mkStat"
 
-maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus 
+maxThreadStopStatusPre77, maxThreadStopStatus782, maxThreadStopStatus
     :: RawThreadStopStatus
 maxThreadStopStatusPre77  = 18 -- see [Stop status in GHC-7.8.2]
 maxThreadStopStatus782    = 19 -- need to distinguish three cases
@@ -520,3 +519,10 @@ toMsgTag = toEnum . fromIntegral . (\n -> n - offset)
 
 fromMsgTag :: MessageTag -> RawMsgTag
 fromMsgTag = (+ offset) . fromIntegral . fromEnum
+
+-- Checks if the capability is not -1 (which indicates a global eventblock), so
+-- has no associated capability
+mkCap :: Int -> Maybe Int
+mkCap cap = do
+  guard $ fromIntegral cap /= (-1 :: Word16)
+  return cap