f0c552663b
This implementation needs to be changed; it currently uses Meta as a primary key for nodes, but that isn't valid.
87 lines
3.5 KiB
Haskell
87 lines
3.5 KiB
Haskell
{-
|
|
Tock: a compiler for parallel languages
|
|
Copyright (C) 2007 University of Kent
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU General Public License as published by the
|
|
Free Software Foundation, either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License along
|
|
with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
-}
|
|
|
|
module FlowGraph (EdgeLabel(..), FlowGraph, buildFlowGraph) where
|
|
|
|
import Control.Monad.Error
|
|
import Control.Monad.State
|
|
import Data.Generics
|
|
import Data.Graph.Inductive
|
|
|
|
import qualified AST as A
|
|
import Metadata
|
|
import Utils
|
|
|
|
data EdgeLabel = EChoice | ESeq | EPar deriving (Show, Eq, Ord)
|
|
|
|
data OuterType = None | Seq | Par
|
|
|
|
type FNode a = (Meta, a)
|
|
--type FEdge = (Node, EdgeLabel, Node)
|
|
|
|
type FlowGraph a = Gr (FNode a) EdgeLabel
|
|
|
|
type NodesEdges a = ([LNode (FNode a)],[LEdge EdgeLabel])
|
|
|
|
type GraphMaker a b = ErrorT String (State (Node, NodesEdges a)) b
|
|
|
|
|
|
buildFlowGraph :: a -> (forall t. Data t => t -> a) -> A.Structured -> Either String (FlowGraph a)
|
|
buildFlowGraph blank f s = case runState (runErrorT $ buildStructured None s) (0, ([],[]) ) of
|
|
(Left err,_) -> Left err
|
|
(_,(_,(nodes, edges))) -> Right (mkGraph nodes edges)
|
|
where
|
|
-- All the functions return the new graph, and the identifier of the node just added
|
|
|
|
addNode :: FNode a -> GraphMaker a Node
|
|
addNode x = do (n,(nodes, edges)) <- get
|
|
put (n+1, ((n, x):nodes, edges))
|
|
return n
|
|
|
|
addEdge :: EdgeLabel -> Node -> Node -> GraphMaker a ()
|
|
addEdge label start end = do (n, (nodes, edges)) <- get
|
|
put (n + 1, (nodes,(start, end, label):edges))
|
|
|
|
-- Type commented out because it's not technically correct, but looks right to me:
|
|
-- addDummyNode :: Meta -> GraphMaker a Node
|
|
addDummyNode m = addNode (m, blank)
|
|
|
|
-- Returns a pair of beginning-node, end-node
|
|
-- Type commented out because it's not technically correct, but looks right to me:
|
|
-- buildStructured :: OuterType -> A.Structured -> GraphMaker a (Node, Node)
|
|
buildStructured outer (A.Several m ss)
|
|
= do nodes <- mapM (buildStructured outer) ss
|
|
case outer of
|
|
None -> throwError "Cannot handle Several without an outer context"
|
|
Seq -> do sequence_ $ mapPairs (\(_,s) (e,_) -> addEdge ESeq s e) nodes
|
|
case nodes of
|
|
[] -> do n <- addDummyNode m
|
|
return (n,n)
|
|
_ -> return (fst (head nodes), snd (last nodes))
|
|
Par -> do nStart <- addDummyNode m
|
|
nEnd <- addDummyNode m
|
|
mapM (\(a,z) -> addEdge EPar nStart a >> addEdge ESeq z nEnd) nodes
|
|
return (nStart, nEnd)
|
|
buildStructured _ (A.OnlyP _ p) = buildProcess p
|
|
|
|
-- Type commented out because it's not technically correct, but looks right to me:
|
|
-- buildProcess :: A.Process -> GraphMaker a (Node, Node)
|
|
buildProcess (A.Seq _ s) = buildStructured Seq s
|
|
buildProcess (A.Par _ _ s) = buildStructured Par s
|
|
buildProcess p@(A.Skip m) = (liftM mkPair) $ addNode (m, f p)
|