content: module Events.EventTree (
       DurationTree(..),
       mkDurationTree,
  
       runTimeOf, gcTimeOf,
       reportDurationTree,
       durationTreeCountNodes,
       durationTreeMaxDepth,
  
       EventTree(..), EventNode(..),
       mkEventTree,
       reportEventTree, eventTreeMaxDepth,
    ) where
  
  import Events.EventDuration
  
  import qualified GHC.RTS.Events as GHC
  import GHC.RTS.Events hiding (Event)
  
  import Text.Printf
  import Control.Exception (assert)
  
  -------------------------------------------------------------------------------
  
  -- We map the events onto a binary search tree, so that we can easily
  -- find the events that correspond to a particular view of the
  -- timeline.  Additionally, each node of the tree contains a summary
  -- of the information below it, so that we can render views at various
  -- levels of resolution.  For example, if a tree node would represent
  -- less than one pixel on the display, there is no point is descending
  -- the tree further.
  
  -- We only split at event boundaries; we never split an event into
  -- multiple pieces.  Therefore, the binary tree is only roughly split
  -- by time, the actual split depends on the distribution of events
  -- below it.
  
  data DurationTree
    = DurationSplit
          {-#UNPACK#-}!Timestamp -- The start time of this run-span
          {-#UNPACK#-}!Timestamp -- The time used to split the events into two parts
          {-#UNPACK#-}!Timestamp -- The end time of this run-span
          DurationTree -- The LHS split; all events lie completely between
                       -- start and split
          DurationTree -- The RHS split; all events lie completely between
                       -- split and end
          {-#UNPACK#-}!Timestamp -- The total amount of time spent running a thread
          {-#UNPACK#-}!Timestamp -- The total amount of time spend in GC
  
    | DurationTreeLeaf
          EventDuration
  
    | DurationTreeEmpty
  
    deriving Show
  
  -------------------------------------------------------------------------------
  
  mkDurationTree :: [EventDuration] -> Timestamp -> DurationTree
  mkDurationTree es endTime =
    -- trace (show tree) $
    tree
   where
    tree = splitDurations es endTime
  
  splitDurations :: [EventDuration] -- events
                 -> Timestamp       -- end time of last event in the list
                 -> DurationTree
  splitDurations [] _endTime =
    -- if len /= 0 then error "splitDurations0" else
    DurationTreeEmpty  -- The case for an empty list of events.
  
  splitDurations [e] _entTime =
    DurationTreeLeaf e
  
  splitDurations es endTime
    | null rhs
    = splitDurations es lhs_end
  
    | null lhs
    = error $
      printf "splitDurations: null lhs: len = %d, startTime = %d, endTime = %d\n"
        (length es) startTime endTime
      ++ '\n': show es
  
    | 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) $
      DurationSplit startTime
                 lhs_end
                 endTime
                 ltree
                 rtree
                 runTime
                 gcTime
      where
      startTime = startTimeOf (head es)
      splitTime = startTime + (endTime - startTime) `div` 2
  
      (lhs, lhs_end, rhs) = splitDurationList es [] splitTime 0
  
      ltree = splitDurations lhs lhs_end
      rtree = splitDurations rhs endTime
  
      runTime = runTimeOf ltree + runTimeOf rtree
      gcTime  = gcTimeOf  ltree + gcTimeOf  rtree
  
  
  splitDurationList :: [EventDuration]
                    -> [EventDuration]
                    -> Timestamp
                    -> Timestamp
                    -> ([EventDuration], Timestamp, [EventDuration])
  splitDurationList []  acc !_tsplit !tmax
    = (reverse acc, tmax, [])
  splitDurationList [e] acc !_tsplit !tmax
    -- Just one event left: put it on the right. This ensures that we
    -- have at least one event on each side of the split.
    = (reverse acc, tmax, [e])
  splitDurationList (e:es) acc !tsplit !tmax
    | tstart <= tsplit  -- pick all events that start at or before the split
    = splitDurationList es (e:acc) tsplit (max tmax tend)
    | otherwise
    = (reverse acc, tmax, e:es)
    where
      tstart = startTimeOf e
      tend   = endTimeOf e
  
  -------------------------------------------------------------------------------
  
  runTimeOf :: DurationTree -> Timestamp
  runTimeOf (DurationSplit _ _ _ _ _ runTime _) = runTime
  runTimeOf (DurationTreeLeaf e) | ThreadRun{} <- e = durationOf e
  runTimeOf (DurationTreeLeaf e) | TXStart {} <- e = durationOf e
  runTimeOf _ = 0
  
  -------------------------------------------------------------------------------
  
  gcTimeOf :: DurationTree -> Timestamp
  gcTimeOf (DurationSplit _ _ _ _ _ _ gcTime) = gcTime
  gcTimeOf (DurationTreeLeaf e) | isGCDuration e = durationOf e
  gcTimeOf _ = 0
  
  -------------------------------------------------------------------------------
  
  reportDurationTree :: Int -> DurationTree -> IO ()
  reportDurationTree hecNumber eventTree
    = putStrLn ("HEC " ++ show hecNumber ++ reportText)
      where
      reportText = " nodes = " ++ show (durationTreeCountNodes eventTree) ++
                   " max depth = " ++ show (durationTreeMaxDepth eventTree)
  
  -------------------------------------------------------------------------------
  
  durationTreeCountNodes :: DurationTree -> Int
  durationTreeCountNodes (DurationSplit _ _ _ lhs rhs _ _)
     = 1 + durationTreeCountNodes lhs + durationTreeCountNodes rhs
  durationTreeCountNodes _ = 1
  
  -------------------------------------------------------------------------------
  
  durationTreeMaxDepth :: DurationTree -> Int
  durationTreeMaxDepth (DurationSplit _ _ _ lhs rhs _ _)
    = 1 + durationTreeMaxDepth lhs `max` durationTreeMaxDepth rhs
  durationTreeMaxDepth _ = 1
  
  -------------------------------------------------------------------------------
  
  data EventTree
      = EventTree
          {-#UNPACK#-}!Timestamp -- The start time of this run-span
          {-#UNPACK#-}!Timestamp -- The end   time of this run-span
          EventNode
  
  data EventNode
    = EventSplit
          {-#UNPACK#-}!Timestamp -- The time used to split the events into two parts
          EventNode -- The LHS split; all events lie completely between
                    -- start and split
          EventNode -- The RHS split; all events lie completely between
                    -- split and end
  
    | EventTreeLeaf [GHC.Event]
          -- sometimes events happen "simultaneously" (at the same time
          -- given the resolution of our clock source), so we can't
          -- separate them.
  
    | EventTreeOne GHC.Event
          -- This is a space optimisation for the common case of
          -- EventTreeLeaf [e].
  
  mkEventTree :: [GHC.Event] -> Timestamp -> EventTree
  mkEventTree es endTime =
    EventTree s e $
    -- trace (show tree) $
    tree
   where
    tree = splitEvents es endTime
    (s,e) = if null es then (0,0) else (time (head es), endTime)
  
  splitEvents :: [GHC.Event] -- events
              -> Timestamp       -- end time of last event in the list
              -> EventNode
  splitEvents []  !_endTime =
    -- if len /= 0 then error "splitEvents0" else
    EventTreeLeaf []   -- The case for an empty list of events
  
  splitEvents [e] !_endTime =
    EventTreeOne e
  
  splitEvents es !endTime
    | duration == 0
    = EventTreeLeaf es
  
    | null rhs
    = splitEvents es lhs_end
  
    | null lhs
    = error $
      printf "splitEvents: null lhs: len = %d, startTime = %d, endTime = %d\n"
        (length es) startTime endTime
      ++ '\n': show es
  
    | 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))
                 ltree
                 rtree
      where
      -- | Integer division, rounding up.
      divUp :: Timestamp -> Timestamp -> Timestamp
      divUp n k = (n + k - 1) `div` k
      startTime = time (head es)
      splitTime = startTime + (endTime - startTime) `divUp` 2
      duration  = endTime - startTime
  
      (lhs, lhs_end, rhs) = splitEventList es [] splitTime 0
  
      ltree = splitEvents lhs lhs_end
      rtree = splitEvents rhs endTime
  
  
  splitEventList :: [GHC.Event]
                 -> [GHC.Event]
                 -> Timestamp
                 -> Timestamp
                 -> ([GHC.Event], Timestamp, [GHC.Event])
  splitEventList []  acc !_tsplit !tmax
    = (reverse acc, tmax, [])
  splitEventList [e] acc !_tsplit !tmax
    -- Just one event left: put it on the right. This ensures that we
    -- have at least one event on each side of the split.
    = (reverse acc, tmax, [e])
  splitEventList (e:es) acc !tsplit !tmax
    | t <= tsplit  -- pick all events that start at or before the split
    = splitEventList es (e:acc) tsplit (max tmax t)
    | otherwise
    = (reverse acc, tmax, e:es)
    where
      t = time e
  
  -------------------------------------------------------------------------------
  
  reportEventTree :: Int -> EventTree -> IO ()
  reportEventTree hecNumber (EventTree _ _ eventTree)
    = putStrLn ("HEC " ++ show hecNumber ++ reportText)
      where
      reportText = " nodes = " ++ show (eventTreeCountNodes eventTree) ++
                   " max depth = " ++ show (eventNodeMaxDepth eventTree)
  
  -------------------------------------------------------------------------------
  
  eventTreeCountNodes :: EventNode -> Int
  eventTreeCountNodes (EventSplit _ lhs rhs)
     = 1 + eventTreeCountNodes lhs + eventTreeCountNodes rhs
  eventTreeCountNodes _ = 1
  
  -------------------------------------------------------------------------------
  
  eventTreeMaxDepth :: EventTree -> Int
  eventTreeMaxDepth (EventTree _ _ t) = eventNodeMaxDepth t
  
  eventNodeMaxDepth :: EventNode -> Int
  eventNodeMaxDepth (EventSplit _ lhs rhs)
    = 1 + eventNodeMaxDepth lhs `max` eventNodeMaxDepth rhs
  eventNodeMaxDepth _ = 1
  