Added support for recording terminator nodes (as well as root nodes) while building the flow graph

Main.hs

@@ -306,7 +306,8 @@ compile mode fn outHandle
                  -- since it is never used.  Then we used graphsTyped (rather than graphs)
                  -- to prevent a compiler warning at graphsTyped being unused;
                  -- graphs is of course identical to graphsTyped, as you can see here:
-                 let (graphsTyped :: [Maybe (FlowGraph' Identity String A.Process)]) = map (transformMaybe fst) graphs
+                 let (graphsTyped :: [Maybe (FlowGraph' Identity String A.Process)])
+                       = map (transformMaybe $ \(x,_,_) -> x) graphs
                  -- TODO: output each process to a separate file, rather than just taking the first:
                  liftIO $ hPutStr outHandle $ head $ map makeFlowGraphInstr (catMaybes graphsTyped)
             ModeCompile ->

checks/Check.hs

@@ -48,7 +48,7 @@ usageCheckPass :: A.AST -> PassMR A.AST
 usageCheckPass t = do g' <- buildFlowGraph labelFunctions t
                       (g, roots) <- case g' of
                         Left err -> dieP (findMeta t) err
-                        Right (g,rs) -> return (g,rs)
+                        Right (g,rs,_) -> return (g,rs)
                       checkPar nodeRep (joinCheckParFunctions checkArrayUsage checkPlainVarUsage) g
                       checkParAssignUsage t
                       checkProcCallArgsUsage t

flow/FlowGraph.hs

@@ -328,9 +328,10 @@ addNewSubProcFunc :: (Monad mLabel, Monad mAlter) =>
 addNewSubProcFunc m args body argsRoute
   = do root <- addNode' m labelStartNode (m, args) (AlterArguments argsRoute)
        denoteRootNode root
-       bodyNode <- case body of
+       (bodyNode, termNode) <- case body of
-         Left (p,route) -> buildProcess p route >>* fst
+         Left (p,route) -> buildProcess p route
-         Right (s,route) -> buildStructuredEL s route >>* fst
+         Right (s,route) -> buildStructuredEL s route
+       denoteTerminatorNode termNode
        addEdge ESeq root bodyNode
 
 buildProcess :: (Monad mLabel, Monad mAlter) => A.Process -> ASTModifier mAlter A.Process structType -> GraphMaker mLabel mAlter label structType (Node, Node)
@@ -385,24 +386,29 @@ buildProcess p route = addNode' (findMeta p) labelProcess p (AlterProcess route)
 -- the parameters, only in the result.  The mLabel monad is the monad in
 -- which the labelling must be done; hence the flow-graph is returned inside
 -- the label monad.
+--
+-- Returns the flow graph, a list of start-roots and a list of terminator nodes
+-- ("end-roots")
 buildFlowGraph :: forall mLabel mAlter label. (Monad mLabel, Monad mAlter) =>
   GraphLabelFuncs mLabel label ->
   A.AST  ->
-  mLabel (Either String (FlowGraph' mAlter label (), [Node]))
+  mLabel (Either String (FlowGraph' mAlter label (), [Node], [Node]))
 buildFlowGraph funcs s
-  = do res <- flip runStateT (0, 0, ([],[]), []) $ flip runReaderT funcs $ runErrorT $ buildStructuredAST s id
+  = do res <- flip runStateT (0, 0, ([],[]), [], []) $ flip runReaderT funcs $ runErrorT $ buildStructuredAST s id
        return $ case res of
                   (Left err,_) -> Left err
-                  (Right _,(_,_,(nodes, edges),roots)) -> Right (mkGraph nodes edges, roots)
+                  (Right _,(_,_,(nodes, edges),roots,terminators))
+                    -> Right (mkGraph nodes edges, roots, terminators)
 
 buildFlowGraphP :: forall mLabel mAlter label. (Monad mLabel, Monad mAlter) =>
   GraphLabelFuncs mLabel label ->
   A.Structured A.Process ->
-  mLabel (Either String (FlowGraph' mAlter label A.Process, [Node]))
+  mLabel (Either String (FlowGraph' mAlter label A.Process, [Node], [Node]))
 buildFlowGraphP funcs s
-  = do res <- flip runStateT (0, 0, ([],[]), []) $ flip runReaderT funcs $ runErrorT $ buildStructuredSeq s id
+  = do res <- flip runStateT (0, 0, ([],[]), [], []) $ flip runReaderT funcs $ runErrorT $ buildStructuredSeq s id
        return $ case res of
                   (Left err,_) -> Left err
-                  (Right (root,_),(_,_,(nodes, edges),roots)) -> Right (mkGraph nodes edges, root : roots)
+                  (Right (root,_),(_,_,(nodes, edges),roots, terminators))
+                    -> Right (mkGraph nodes edges, root : roots, terminators)
 
     

flow/FlowUtils.hs

@@ -86,7 +86,8 @@ type NodesEdges m a b = ([LNode (FNode' m a b)],[LEdge EdgeLabel])
 -- * The next identifier for a PAR item (for the EStartPar\/EEndPar edges)
 -- * The list of nodes and edges to put into the graph
 -- * The list of root nodes thus far (those with no links to them)
-type GraphMakerState mAlter a b = (Node, Int, NodesEdges mAlter a b, [Node])
+-- * The list of terminator nodes thus far (those with no links from them)
+type GraphMakerState mAlter a b = (Node, Int, NodesEdges mAlter a b, [Node], [Node])
 
 type GraphMaker mLabel mAlter a b c = ErrorT String (ReaderT (GraphLabelFuncs mLabel a) (StateT (GraphMakerState mAlter a b) mLabel)) c
 
@@ -160,21 +161,27 @@ run func x = do f <- asks func
                 lift . lift .lift $ f x
 
 addNode :: (Monad mLabel, Monad mAlter) => (Meta, label, AlterAST mAlter structType) -> GraphMaker mLabel mAlter label structType Node
-addNode x = do (n,pi,(nodes, edges), rs) <- get
+addNode x = do (n,pi,(nodes, edges), rs, ts) <- get
-               put (n+1, pi,((n, Node x):nodes, edges), rs)
+               put (n+1, pi,((n, Node x):nodes, edges), rs, ts)
                return n
     
 denoteRootNode :: (Monad mLabel, Monad mAlter) => Node -> GraphMaker mLabel mAlter label structType ()
-denoteRootNode root = do (n, pi, nes, roots) <- get
+denoteRootNode root = do (n, pi, nes, roots, ts) <- get
-                         put (n, pi, nes, root : roots)
+                         put (n, pi, nes, root : roots, ts)
+
+denoteTerminatorNode :: (Monad mLabel, Monad mAlter) => Node -> GraphMaker mLabel mAlter label structType ()
+denoteTerminatorNode t = do (n, pi, nes, roots, ts) <- get
+                            put (n, pi, nes, roots, t : ts)
+
     
 addEdge :: (Monad mLabel, Monad mAlter) => EdgeLabel -> Node -> Node -> GraphMaker mLabel mAlter label structType ()
-addEdge label start end = do (n, pi, (nodes, edges), rs) <- get
+addEdge label start end = do (n, pi, (nodes, edges), rs, ts) <- get
                              -- Edges should only be added after the nodes, so
                              -- for safety here we can check that the nodes exist:
                              if (notElem start $ map fst nodes) || (notElem end $ map fst nodes)
                                then throwError "Could not add edge between non-existent nodes"
-                               else put (n + 1, pi, (nodes,(start, end, label):edges), rs)
+                               else put (n + 1, pi, (nodes,(start, end, label):edges), rs,
+                                 ts)
 
 -- It is important for the flow-graph tests that the Meta tag passed in is the same as the
 -- result of calling findMeta on the third parameter
@@ -192,14 +199,14 @@ addDummyNode :: (Monad mLabel, Monad mAlter) => Meta -> GraphMaker mLabel mAlter
 addDummyNode m = addNode' m labelDummy m AlterNothing
 
 getNextParEdgeId :: (Monad mLabel, Monad mAlter) => GraphMaker mLabel mAlter label structType Int
-getNextParEdgeId = do (a, pi, b, c) <- get
+getNextParEdgeId = do (a, pi, b, c, d) <- get
-                      put (a, pi + 1, b, c)
+                      put (a, pi + 1, b, c, d)
                       return pi
 
 addParEdges :: (Monad mLabel, Monad mAlter) => Int -> (Node,Node) -> [(Node,Node)] -> GraphMaker mLabel mAlter label structType ()
 addParEdges usePI (s,e) pairs
-  = do (n,pi,(nodes,edges),rs) <- get
+  = do (n,pi,(nodes,edges),rs,ts) <- get
-       put (n,pi,(nodes,edges ++ (concatMap (parEdge usePI) pairs)),rs)
+       put (n,pi,(nodes,edges ++ (concatMap (parEdge usePI) pairs)),rs,ts)
   where
     parEdge :: Int -> (Node, Node) -> [LEdge EdgeLabel]
     parEdge id (a,z) = [(s,a,(EStartPar id)),(z,e,(EEndPar id))]