module GHC.RTS.Events.Analysis.SparkThread
  ( SparkThreadState (..)
  , sparkThreadMachine
  , capabilitySparkThreadMachine
  , capabilitySparkThreadIndexer
  )
 where

import GHC.RTS.Events
import GHC.RTS.Events.Analysis

import Data.Map (Map)
import qualified Data.Map as M
import Data.Set (Set)
import qualified Data.Set as S

data SparkThreadState
  = SparkThreadInitial
  | SparkThreadCreated
  | SparkThreadRunning Int
  | SparkThreadPaused Int
  | SparkThreadFinal
  deriving (SparkThreadState -> SparkThreadState -> Bool
(SparkThreadState -> SparkThreadState -> Bool)
-> (SparkThreadState -> SparkThreadState -> Bool)
-> Eq SparkThreadState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SparkThreadState -> SparkThreadState -> Bool
$c/= :: SparkThreadState -> SparkThreadState -> Bool
== :: SparkThreadState -> SparkThreadState -> Bool
$c== :: SparkThreadState -> SparkThreadState -> Bool
Eq, Eq SparkThreadState
Eq SparkThreadState
-> (SparkThreadState -> SparkThreadState -> Ordering)
-> (SparkThreadState -> SparkThreadState -> Bool)
-> (SparkThreadState -> SparkThreadState -> Bool)
-> (SparkThreadState -> SparkThreadState -> Bool)
-> (SparkThreadState -> SparkThreadState -> Bool)
-> (SparkThreadState -> SparkThreadState -> SparkThreadState)
-> (SparkThreadState -> SparkThreadState -> SparkThreadState)
-> Ord SparkThreadState
SparkThreadState -> SparkThreadState -> Bool
SparkThreadState -> SparkThreadState -> Ordering
SparkThreadState -> SparkThreadState -> SparkThreadState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SparkThreadState -> SparkThreadState -> SparkThreadState
$cmin :: SparkThreadState -> SparkThreadState -> SparkThreadState
max :: SparkThreadState -> SparkThreadState -> SparkThreadState
$cmax :: SparkThreadState -> SparkThreadState -> SparkThreadState
>= :: SparkThreadState -> SparkThreadState -> Bool
$c>= :: SparkThreadState -> SparkThreadState -> Bool
> :: SparkThreadState -> SparkThreadState -> Bool
$c> :: SparkThreadState -> SparkThreadState -> Bool
<= :: SparkThreadState -> SparkThreadState -> Bool
$c<= :: SparkThreadState -> SparkThreadState -> Bool
< :: SparkThreadState -> SparkThreadState -> Bool
$c< :: SparkThreadState -> SparkThreadState -> Bool
compare :: SparkThreadState -> SparkThreadState -> Ordering
$ccompare :: SparkThreadState -> SparkThreadState -> Ordering
$cp1Ord :: Eq SparkThreadState
Ord, Int -> SparkThreadState -> ShowS
[SparkThreadState] -> ShowS
SparkThreadState -> String
(Int -> SparkThreadState -> ShowS)
-> (SparkThreadState -> String)
-> ([SparkThreadState] -> ShowS)
-> Show SparkThreadState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SparkThreadState] -> ShowS
$cshowList :: [SparkThreadState] -> ShowS
show :: SparkThreadState -> String
$cshow :: SparkThreadState -> String
showsPrec :: Int -> SparkThreadState -> ShowS
$cshowsPrec :: Int -> SparkThreadState -> ShowS
Show)

sparkThreadMachine :: Machine SparkThreadState EventInfo
sparkThreadMachine :: Machine SparkThreadState EventInfo
sparkThreadMachine = Machine :: forall s i.
s
-> (s -> Bool) -> (i -> Bool) -> (s -> i -> Maybe s) -> Machine s i
Machine
  { initial :: SparkThreadState
initial = SparkThreadState
SparkThreadInitial
  , final :: SparkThreadState -> Bool
final   = SparkThreadState -> Bool
sparkThreadFinal
  , alpha :: EventInfo -> Bool
alpha   = EventInfo -> Bool
sparkThreadAlpha
  , delta :: SparkThreadState -> EventInfo -> Maybe SparkThreadState
delta   = SparkThreadState -> EventInfo -> Maybe SparkThreadState
sparkThreadDelta
  }
 where
  sparkThreadFinal :: SparkThreadState -> Bool
sparkThreadFinal SparkThreadState
SparkThreadFinal = Bool
True
  sparkThreadFinal SparkThreadState
_                = Bool
False

  -- sparkThreadAlpha (CreateSparkThread _) = True
  sparkThreadAlpha :: EventInfo -> Bool
sparkThreadAlpha (RunThread ThreadId
_)         = Bool
True
  sparkThreadAlpha (StopThread ThreadId
_ ThreadStopStatus
_)      = Bool
True
  sparkThreadAlpha EventInfo
SparkRun              = Bool
True
  sparkThreadAlpha (SparkSteal Int
_)        = Bool
True
  sparkThreadAlpha EventInfo
_                     = Bool
False

  -- SparkThreadInitial
  -- sparkThreadDelta SparkThreadInitial (CreateSparkThread _) = Just SparkThreadInitial
  sparkThreadDelta :: SparkThreadState -> EventInfo -> Maybe SparkThreadState
sparkThreadDelta SparkThreadState
SparkThreadInitial (RunThread ThreadId
_)         = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just SparkThreadState
SparkThreadCreated
  -- SparkThreadCreated
  sparkThreadDelta SparkThreadState
SparkThreadCreated EventInfo
SparkRun                      = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just (Int -> SparkThreadState
SparkThreadRunning Int
0)
  sparkThreadDelta SparkThreadState
SparkThreadCreated (SparkSteal Int
_)                = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just (Int -> SparkThreadState
SparkThreadRunning Int
0)
  sparkThreadDelta SparkThreadState
SparkThreadCreated (StopThread ThreadId
_ ThreadStopStatus
ThreadFinished) = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just SparkThreadState
SparkThreadFinal
  -- SparkThreadRunning
  sparkThreadDelta (SparkThreadRunning Int
_) (StopThread ThreadId
_ ThreadStopStatus
ThreadFinished) = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just SparkThreadState
SparkThreadFinal
  sparkThreadDelta (SparkThreadRunning Int
n) (StopThread ThreadId
_ ThreadStopStatus
_)              = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just (Int -> SparkThreadState
SparkThreadPaused Int
n)
  sparkThreadDelta (SparkThreadRunning Int
n) EventInfo
SparkRun                      = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just (Int -> SparkThreadState
SparkThreadRunning (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
  sparkThreadDelta (SparkThreadRunning Int
n) (SparkSteal Int
_)                = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just (Int -> SparkThreadState
SparkThreadRunning (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
  -- SparkThreadPaused
  sparkThreadDelta (SparkThreadPaused Int
n) (RunThread ThreadId
_) = SparkThreadState -> Maybe SparkThreadState
forall a. a -> Maybe a
Just (Int -> SparkThreadState
SparkThreadRunning Int
n)
  -- Other
  sparkThreadDelta SparkThreadState
_ EventInfo
_ = Maybe SparkThreadState
forall a. Maybe a
Nothing

capabilitySparkThreadMachine :: Machine (Map Int ThreadId, Set ThreadId) Event
capabilitySparkThreadMachine :: Machine (Map Int ThreadId, Set ThreadId) Event
capabilitySparkThreadMachine = Machine :: forall s i.
s
-> (s -> Bool) -> (i -> Bool) -> (s -> i -> Maybe s) -> Machine s i
Machine
  { initial :: (Map Int ThreadId, Set ThreadId)
initial = (Map Int ThreadId
forall k a. Map k a
M.empty, Set ThreadId
forall a. Set a
S.empty)
  , final :: (Map Int ThreadId, Set ThreadId) -> Bool
final   = Bool -> (Map Int ThreadId, Set ThreadId) -> Bool
forall a b. a -> b -> a
const Bool
False
  , alpha :: Event -> Bool
alpha   = Event -> Bool
capabilitySparkThreadAlpha
  , delta :: (Map Int ThreadId, Set ThreadId)
-> Event -> Maybe (Map Int ThreadId, Set ThreadId)
delta   = (Map Int ThreadId, Set ThreadId)
-> Event -> Maybe (Map Int ThreadId, Set ThreadId)
capabilitySparkThreadDelta
  }
 where
  capabilitySparkThreadAlpha :: Event -> Bool
capabilitySparkThreadAlpha Event
evt = case Event -> EventInfo
evSpec Event
evt of
    (CreateSparkThread ThreadId
_)         -> Bool
True
    (RunThread ThreadId
_)                 -> Bool
True
    (StopThread ThreadId
_ ThreadStopStatus
_)              -> Bool
True
    EventInfo
_                             -> Bool
False
  capabilitySparkThreadDelta :: (Map Int ThreadId, Set ThreadId)
-> Event -> Maybe (Map Int ThreadId, Set ThreadId)
capabilitySparkThreadDelta (Map Int ThreadId
m, Set ThreadId
s) Event
evt = do
    Int
capId <- Event -> Maybe Int
evCap Event
evt
    case Event -> EventInfo
evSpec Event
evt of
      (CreateSparkThread ThreadId
threadId)         -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
createThread ThreadId
threadId
      (StopThread ThreadId
threadId ThreadStopStatus
_)              -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
pauseThread ThreadId
threadId
      (RunThread ThreadId
threadId)                 -> Int -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
runThread Int
capId ThreadId
threadId
      EventInfo
_                                    -> (Map Int ThreadId, Set ThreadId)
-> Maybe (Map Int ThreadId, Set ThreadId)
forall a. a -> Maybe a
Just (Map Int ThreadId
m, Set ThreadId
s)
   where
    createThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    createThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
createThread ThreadId
threadId
      | ThreadId -> Set ThreadId -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ThreadId
threadId Set ThreadId
s = Maybe (Map Int ThreadId, Set ThreadId)
forall a. Maybe a
Nothing -- A spark thread with this Id already created
      | Bool
otherwise           = (Map Int ThreadId, Set ThreadId)
-> Maybe (Map Int ThreadId, Set ThreadId)
forall a. a -> Maybe a
Just (Map Int ThreadId
m, ThreadId -> Set ThreadId -> Set ThreadId
forall a. Ord a => a -> Set a -> Set a
S.insert ThreadId
threadId Set ThreadId
s)

    runThread :: Int -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    runThread :: Int -> ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
runThread Int
capId ThreadId
threadId
      | Int -> Map Int ThreadId -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Int
capId Map Int ThreadId
m          = Maybe (Map Int ThreadId, Set ThreadId)
forall a. Maybe a
Nothing      -- A thread is already on this cap
      | ThreadId
threadId ThreadId -> [ThreadId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map Int ThreadId -> [ThreadId]
forall k a. Map k a -> [a]
M.elems Map Int ThreadId
m = Maybe (Map Int ThreadId, Set ThreadId)
forall a. Maybe a
Nothing      -- This thread is already on a cap
      | ThreadId -> Set ThreadId -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember ThreadId
threadId Set ThreadId
s    = (Map Int ThreadId, Set ThreadId)
-> Maybe (Map Int ThreadId, Set ThreadId)
forall a. a -> Maybe a
Just (Map Int ThreadId
m, Set ThreadId
s)  -- Not a spark thread
      | Bool
otherwise                 = (Map Int ThreadId, Set ThreadId)
-> Maybe (Map Int ThreadId, Set ThreadId)
forall a. a -> Maybe a
Just (Int -> ThreadId -> Map Int ThreadId -> Map Int ThreadId
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
capId ThreadId
threadId Map Int ThreadId
m, ThreadId -> Set ThreadId -> Set ThreadId
forall a. Ord a => a -> Set a -> Set a
S.insert ThreadId
threadId Set ThreadId
s)

    stopThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    stopThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
stopThread ThreadId
threadId = (Map Int ThreadId, Set ThreadId)
-> Maybe (Map Int ThreadId, Set ThreadId)
forall a. a -> Maybe a
Just ((ThreadId -> Bool) -> Map Int ThreadId -> Map Int ThreadId
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (ThreadId -> ThreadId -> Bool
forall a. Eq a => a -> a -> Bool
/= ThreadId
threadId) Map Int ThreadId
m, ThreadId -> Set ThreadId -> Set ThreadId
forall a. Ord a => a -> Set a -> Set a
S.delete ThreadId
threadId Set ThreadId
s)

    pauseThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
    pauseThread :: ThreadId -> Maybe (Map Int ThreadId, Set ThreadId)
pauseThread ThreadId
threadId = (Map Int ThreadId, Set ThreadId)
-> Maybe (Map Int ThreadId, Set ThreadId)
forall a. a -> Maybe a
Just ((ThreadId -> Bool) -> Map Int ThreadId -> Map Int ThreadId
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (ThreadId -> ThreadId -> Bool
forall a. Eq a => a -> a -> Bool
/= ThreadId
threadId) Map Int ThreadId
m, Set ThreadId
s)

capabilitySparkThreadIndexer :: (Map Int ThreadId, Set ThreadId) -> Event -> Maybe ThreadId
capabilitySparkThreadIndexer :: (Map Int ThreadId, Set ThreadId) -> Event -> Maybe ThreadId
capabilitySparkThreadIndexer (Map Int ThreadId
m, Set ThreadId
s) Event
evt = case Event -> EventInfo
evSpec Event
evt of
  (CreateThread ThreadId
threadId)   -> ThreadId -> Maybe ThreadId
inSparkThreadPool ThreadId
threadId
  (RunThread ThreadId
threadId)      -> ThreadId -> Maybe ThreadId
inSparkThreadPool ThreadId
threadId
  (StopThread ThreadId
threadId ThreadStopStatus
_)   -> ThreadId -> Maybe ThreadId
inSparkThreadPool ThreadId
threadId
  EventInfo
_                         -> Event -> Maybe Int
evCap Event
evt Maybe Int -> (Int -> Maybe ThreadId) -> Maybe ThreadId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Int
capId -> Int -> Map Int ThreadId -> Maybe ThreadId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
capId Map Int ThreadId
m)
 where
  inSparkThreadPool :: ThreadId -> Maybe ThreadId
  inSparkThreadPool :: ThreadId -> Maybe ThreadId
inSparkThreadPool ThreadId
threadId
    | ThreadId -> Set ThreadId -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ThreadId
threadId Set ThreadId
s = ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
threadId
    | Bool
otherwise           = Maybe ThreadId
forall a. Maybe a
Nothing