From cde83c83aef65c31270ac1869e8ef01b09106058 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Sun, 28 Oct 2007 12:11:27 +0000
Subject: [PATCH] Added the capability of outputting graphviz scripts
 representing control-flow graphs

---
 Main.hs             | 18 +++++++++++++++++-
 common/CompState.hs | 14 +++++++++++++-
 2 files changed, 30 insertions(+), 2 deletions(-)

diff --git a/Main.hs b/Main.hs
index b309d6c..b9ca72c 100644
--- a/Main.hs
+++ b/Main.hs
@@ -21,6 +21,8 @@ module Main (main) where
 
 import Control.Monad.Error
 import Control.Monad.State
+import Data.Either
+import Data.Maybe
 import List
 import System
 import System.Console.GetOpt
@@ -30,15 +32,19 @@ import System.IO
 import System.Process
 
 import AnalyseAsm
+import qualified AST as A
 import CompilerCommands
 import CompState
 import Errors
+import FlowGraph
 import GenerateC
 import GenerateCPPCSP
+import Metadata
 import ParseOccam
 import ParseRain
 import Pass
 import PreprocessOccam
+import PrettyShow
 import RainPasses
 import SimplifyComms
 import SimplifyExprs
@@ -59,7 +65,7 @@ type OptFunc = CompState -> IO CompState
 
 options :: [OptDescr OptFunc]
 options =
-  [ Option [] ["mode"] (ReqArg optMode "MODE") "select mode (options: parse, compile, post-c, full)"
+  [ Option [] ["mode"] (ReqArg optMode "MODE") "select mode (options: flowgraph, parse, compile, post-c, full)"
   , Option [] ["backend"] (ReqArg optBackend "BACKEND") "code-generating backend (options: c, cppcsp)"
   , Option [] ["frontend"] (ReqArg optFrontend "FRONTEND") "language frontend (options: occam, rain)"
   , Option ['v'] ["verbose"] (NoArg $ optVerbose) "be more verbose (use multiple times for more detail)"
@@ -69,6 +75,7 @@ options =
 optMode :: String -> OptFunc
 optMode s ps
     =  do mode <- case s of
+            "flowgraph" -> return ModeFlowGraph
             "parse" -> return ModeParse
             "compile" -> return ModeCompile
             "post-c" -> return ModePostC
@@ -134,6 +141,7 @@ main = do
   let operation
         = case csMode initState of
             ModeParse -> useOutputOptions (compile ModeParse fn)
+            ModeFlowGraph -> useOutputOptions (compile ModeFlowGraph fn)
             ModeCompile -> useOutputOptions (compile ModeCompile fn)
             ModePostC -> useOutputOptions (postCAnalyse fn)
             ModeFull -> evalStateT (compileFull fn) []
@@ -251,6 +259,14 @@ compile mode fn outHandle
         output <-
           case mode of
             ModeParse -> return $ show ast1
+            ModeFlowGraph ->
+              do procs <- findAllProcesses
+                 graphs <- mapM
+                      ((liftM $ either (const Nothing) Just) . (buildFlowGraph (const (return "")) ((liftM $ (take 20) . (filter ((/=) '\"'))) . pshowCode)) )
+                      (map (A.OnlyP emptyMeta) (snd $ unzip $ procs))
+                 --TODO output each process to a separate file, rather than just taking the first:
+                 return $ head $ map makeFlowGraphInstr (catMaybes graphs)
+
             ModeCompile ->
               do progress "Passes:"
 
diff --git a/common/CompState.hs b/common/CompState.hs
index 7c8f940..186a67a 100644
--- a/common/CompState.hs
+++ b/common/CompState.hs
@@ -24,6 +24,7 @@ import Control.Monad.State
 import Data.Generics
 import Data.Map (Map)
 import qualified Data.Map as Map
+import Data.Maybe
 import Data.Set (Set)
 import qualified Data.Set as Set
 
@@ -32,7 +33,7 @@ import Errors
 import Metadata
 
 -- | Modes that Tock can run in.
-data CompMode = ModeParse | ModeCompile | ModePostC | ModeFull
+data CompMode = ModeFlowGraph | ModeParse | ModeCompile | ModePostC | ModeFull
   deriving (Show, Data, Typeable, Eq)
 
 -- | Backends that Tock can use.
@@ -255,3 +256,14 @@ dieC str = str >>= die
 
 throwErrorC :: (CSM m,MonadError ErrorReport m) => (Maybe Meta,m String) -> m a
 throwErrorC (m,str) = str >>= ((curry throwError) m)
+
+findAllProcesses :: CSM m => m [(String,A.Process)]
+findAllProcesses
+  = do st <- get
+       return $ mapMaybe findAllProcesses' (Map.assocs $ csNames st)
+  where
+    findAllProcesses' :: (String, A.NameDef) -> Maybe (String, A.Process)
+    findAllProcesses' (n, nd)
+      = case A.ndType nd of
+          A.Proc _ _ _ p -> Just (n, p)
+          _ -> Nothing