diff --git a/src/Search/Search.hs b/src/Search/Search.hs index 448c51a3d9c27c2f8de58fd439bc9d4dd5294a74..2f415d46d7d51f13ea941477454ce32ff38b15c0 100644 --- a/src/Search/Search.hs +++ b/src/Search/Search.hs @@ -86,11 +86,11 @@ findOpenDecision = listToMaybe . mapMaybe isHalf . M.elems . decisions driver :: FilePath -> Bool -- ^ Identify states on different locations? -> IO () -driver prog False = driver' prog (Vertex ("", "start") :: Vertex 'StateAndSyscall) -driver prog True = driver' prog (Vertex ("", "start") :: Vertex 'OnlyState) +driver prog identStates = driver' prog identStates (Vertex ("", "start") :: Vertex 'StateAndSyscall) +--driver prog True = driver' prog (Vertex ("", "start") :: Vertex 'OnlyState) -driver' :: Ord (Vertex a) => FilePath -> Vertex a -> IO () -driver' prog startVertex = do +driver' :: Ord (Vertex a) => FilePath -> Bool -> Vertex a -> IO () +driver' prog identStates startVertex = do state <- newIORef (State M.empty (Just startVertex) M.empty []) oneProgRun prog state Nothing @@ -99,7 +99,7 @@ driver' prog startVertex = do findOpenDecision <$> readIORef state >>= \case Nothing -> do s <- readIORef state - T.putStrLn (graph2Dot (graph s)) + T.putStrLn (graph2Dot identStates (graph s)) exitSuccess Just trace -> oneProgRun prog state (Just $ reverse trace) @@ -167,29 +167,31 @@ handleLine pstdin state = parseLine pstdin >>= \case NewState vert -> modifyIORef state (addVertex vert) >> return (NewState vert) other -> return other -graph2Dot :: Ord (Vertex a) => Graph a -> Text -graph2Dot graph = +graph2Dot :: Ord (Vertex a) => Bool -> Graph a -> Text +graph2Dot is graph = "digraph gcfg {\n" - <> dotNodes graph + <> dotNodes is graph <> M.foldMapWithKey nodeStr graph <> "}" where nodeStr from tos = mconcat $ map (arrow from) $ S.toList tos - arrow from to = " " <> nodeId from <> " -> " - <> nodeId to <> " [label=\"" <> edgeLabel (fst $ unVertex from) <> "\"];\n" + arrow from to = " " <> nodeId is from <> " -> " + <> nodeId is to <> " [label=\"" <> edgeLabel (fst $ unVertex from) <> "\"];\n" edgeLabel txt = T.dropEnd 1 $ T.dropWhileEnd (/='_') $ T.drop (T.length "OSEKOS_") txt -dotNodes :: Ord (Vertex a) => Graph a -> Text -dotNodes = foldMap formatNode . allNotes +dotNodes :: Ord (Vertex a) => Bool -> Graph a -> Text +dotNodes is = foldMap formatNode . allNotes where allNotes m = M.keysSet m `S.union` fold m - formatNode (Vertex (call, state)) = nodeId (Vertex (call,state)) + formatNode (Vertex (call, state)) = nodeId is (Vertex (call,state)) <> " [label=\"" - <> "State: " <> state <> "\\n" - <> "Syscall: " <> call + <> "State: " <> state + <> (if not is then "\\nSyscall: " <> call else mempty) <> "\", shape=box];\n" -nodeId :: Vertex a -> Text -nodeId (Vertex (call, state)) = "node" <> state <> "_" <> call +nodeId :: Bool -> Vertex a -> Text +nodeId False (Vertex (call, state)) = "node" <> state <> "_" <> call +nodeId True (Vertex (_, state)) = "node" <> state +