Add fake idle thread to search graph

Adds an artificial node to the search graph that mimics the IdleThread
node from the SSE-Graph

src/Search/Prepare.hs

+{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Search.Prepare (prepareForCompare) where
+module Search.Prepare
+  ( prepareForCompare
+  , addIdleThreadNode
+  ) where
 
 import           Data.Monoid
+import           Data.List
 
 import qualified Data.Graph.Inductive as G
 import           Data.Text (Text)
+import qualified Data.Text as T
 import           Lens.Micro
 
 import           Search.Types
 
+-- | Add IdleThread node and pretty print labels.
+--
+-- Converts the search graph to a format that is comparable with dOSEK's
+-- SSE-graph.
 prepareForCompare :: Graph VertexLabel EdgeLabel -> Graph Text Text
-prepareForCompare = over _graph (G.nemap formatNode formatEdge)
+prepareForCompare = over _graph (G.nemap formatNode formatEdge) . addIdleThreadNode
 
 formatNode :: VertexLabel -> Text
 formatNode vert = vertState vert <> "@" <> vertABB vert
 
 formatEdge :: EdgeLabel -> Text
 formatEdge Nothing = ""  -- should not happen after EpsilonElimination
-formatEdge (Just label) = (label^.edgeSyscall) <> "/" <> (label^.edgeABB)
+formatEdge (Just label) =
+  -- TODO Maybe replace only first underscore
+  -- The label looks like 'ABB20_TerminateTask' and we want 'ABB20/TerminateTask'
+  T.replace "_" "/" (label^.edgeABB)
+
+-- TODO Add tests
+-- | Add a node for the IdleThread to be more similar to dOSEK's SSE-graph.
+--
+-- This inserts a new node after the PreIdleHook with a self loop labeled
+-- "Idle". All outgoing edges from the PreIdleHook are moved to the new node and
+-- a new edge labeled "IdleKickoff" is inserted to connect PreIdleHook and
+-- IdleThread.
+addIdleThreadNode :: Graph VertexLabel EdgeLabel -> Graph VertexLabel EdgeLabel
+addIdleThreadNode g =
+  let
+    Just preIdleHook = findNodeByLabel ((=="PreIdleHook").vertABB) g
+    idleThread = VertexLabel "IdleThread" "IdleThread" ""
+    [idleThreadNode] = G.newNodes 1 (g^._graph)
+    selfLoop = Just (EdgeLabel "Idle" "Idle")
+    kickoff = Just (EdgeLabel "IdleKickoff" "IdleKickoff")
+  in
+    g & _graph %~ G.insNode (idleThreadNode, idleThread)
+      & moveOutgoingEdges preIdleHook idleThreadNode
+      & _graph %~ G.insEdge (idleThreadNode, idleThreadNode, selfLoop)
+      & _graph %~ G.insEdge (preIdleHook, idleThreadNode, kickoff)
+
+findNodeByLabel :: (n -> Bool) -> Graph n e -> Maybe G.Node
+findNodeByLabel f g = fst <$> find (f . snd) (G.labNodes (g^._graph))
+
+outLEdges :: G.Node -> Lens' (Graph n e) [(G.LEdge e)]
+outLEdges node = lens getter setter
+  where
+    getter g = G.out (g^._graph) node
+    setter g edges =
+      let
+        previousEdges = getter g
+      in
+        g & _graph %~ G.delEdges (map G.toEdge previousEdges)
+          & _graph %~ G.insEdges edges
+
+-- | Move outgoing edges from one node to another.
+--
+-- Deletes the edges from the first node and adds it to the second
+moveOutgoingEdges :: G.Node -> G.Node -> Graph a b -> Graph a b
+moveOutgoingEdges from to g =
+  let
+    fromOut = g ^. outLEdges from
+  in
+    g & outLEdges from .~ []
+      & outLEdges to .~ (fromOut & each . _1 .~ to)

src/Search/Search.hs

@@ -98,7 +98,7 @@ driver ee dumpJSON prog = driver' ee dumpJSON prog (VertexLabel "start" "" "")
 
 driver' :: EliminateEpsilons -> DumpJSON -> FilePath -> VertexLabel -> IO (Graph Text Text)
 driver' elimEpsis dumpJSON prog startVertex = do
-  let startOS = Just (EdgeLabel "startOS" "noABB")  -- first edge
+  let startOS = Just (EdgeLabel "startOS" "startOS")  -- first edge
   state <- newIORef $ State
     { _foundGraph = singletonGraph 0 startVertex
     , _vertices = M.singleton startVertex 0