Upgraded the Par edges in the flow graph from Int to Integer, which makes the design a bit nicer

This commit is contained in:
Neil Brown 2009-02-09 16:08:59 +00:00
parent 7cf83512c5
commit 7f8ced3c3a
3 changed files with 13 additions and 13 deletions

View File

@ -41,13 +41,13 @@ joinCheckParFunctions f g x = seqPair (f x, g x)
checkPar :: forall m a b. Monad m => (a -> Maybe (A.Name, A.Replicator)) -> ((Meta, ParItems a) -> m b) -> FlowGraph m a -> m [b] checkPar :: forall m a b. Monad m => (a -> Maybe (A.Name, A.Replicator)) -> ((Meta, ParItems a) -> m b) -> FlowGraph m a -> m [b]
checkPar getRep f g = mapM f =<< allParItems checkPar getRep f g = mapM f =<< allParItems
where where
allStartParEdges :: m (Map.Map Int (Maybe (A.Name, A.Replicator), [(Node,Node)])) allStartParEdges :: m (Map.Map Integer (Maybe (A.Name, A.Replicator), [(Node,Node)]))
allStartParEdges = foldM helper Map.empty parEdges allStartParEdges = foldM helper Map.empty parEdges
where where
parEdges = mapMaybe tagStartParEdge $ labEdges g parEdges = mapMaybe tagStartParEdge $ labEdges g
helper :: Map.Map Int (Maybe (A.Name, A.Replicator), [(Node,Node)]) -> (Node,Node,Int) -> helper :: Map.Map Integer (Maybe (A.Name, A.Replicator), [(Node,Node)]) -> (Node,Node,Integer) ->
m (Map.Map Int (Maybe (A.Name, A.Replicator), [(Node,Node)])) m (Map.Map Integer (Maybe (A.Name, A.Replicator), [(Node,Node)]))
helper mp (s,e,n) helper mp (s,e,n)
| r == Nothing = fail "Could not find label for node" | r == Nothing = fail "Could not find label for node"
| prevR == Nothing || prevR == r = return $ Map.insertWith add n (join r,[(s,e)]) mp | prevR == Nothing || prevR == r = return $ Map.insertWith add n (join r,[(s,e)]) mp
@ -61,7 +61,7 @@ checkPar getRep f g = mapM f =<< allParItems
r :: Maybe (Maybe (A.Name, A.Replicator)) r :: Maybe (Maybe (A.Name, A.Replicator))
r = lab g s >>* (getRep . getNodeData) r = lab g s >>* (getRep . getNodeData)
tagStartParEdge :: (Node,Node,EdgeLabel) -> Maybe (Node,Node,Int) tagStartParEdge :: (Node,Node,EdgeLabel) -> Maybe (Node,Node,Integer)
tagStartParEdge (s,e,EStartPar n) = Just (s,e,n) tagStartParEdge (s,e,EStartPar n) = Just (s,e,n)
tagStartParEdge _ = Nothing tagStartParEdge _ = Nothing
@ -78,13 +78,13 @@ checkPar getRep f g = mapM f =<< allParItems
where where
distinctItems = nub $ map fst ns distinctItems = nub $ map fst ns
findMetaAndNodes :: (Int,(Maybe (A.Name, A.Replicator), [(Node,Node)])) -> m (Meta, ParItems a) findMetaAndNodes :: (Integer,(Maybe (A.Name, A.Replicator), [(Node,Node)])) -> m (Meta, ParItems a)
findMetaAndNodes x@(_,(_,ns)) = seqPair (checkAndGetMeta ns, return $ findNodes x) findMetaAndNodes x@(_,(_,ns)) = seqPair (checkAndGetMeta ns, return $ findNodes x)
findNodes :: (Int,(Maybe (A.Name, A.Replicator), [(Node,Node)])) -> ParItems a findNodes :: (Integer,(Maybe (A.Name, A.Replicator), [(Node,Node)])) -> ParItems a
findNodes (n, (mr, ses)) = maybe id RepParItem mr $ ParItems $ map (makeSeqItems n . snd) ses findNodes (n, (mr, ses)) = maybe id RepParItem mr $ ParItems $ map (makeSeqItems n . snd) ses
makeSeqItems :: Int -> Node -> ParItems a makeSeqItems :: Integer -> Node -> ParItems a
makeSeqItems n e = SeqItems (followUntilEdge e (EEndPar n)) makeSeqItems n e = SeqItems (followUntilEdge e (EEndPar n))
-- | We need to follow all edges out of a particular node until we reach -- | We need to follow all edges out of a particular node until we reach

View File

@ -194,7 +194,7 @@ buildStructuredSeq (A.ProcThen _ p str) route
pe --> ss pe --> ss
return (ps, se) return (ps, se)
buildStructuredPar :: (Monad mLabel, Monad mAlter) => Int -> (Node, Node) -> buildStructuredPar :: (Monad mLabel, Monad mAlter) => Integer -> (Node, Node) ->
A.Structured A.Process -> ASTModifier mAlter (A.Structured A.Process) structType -> A.Structured A.Process -> ASTModifier mAlter (A.Structured A.Process) structType ->
GraphMaker mLabel mAlter label structType (Either Bool (Node, Node)) GraphMaker mLabel mAlter label structType (Either Bool (Node, Node))
buildStructuredPar pId (nStart, nEnd) (A.Several m ss) route buildStructuredPar pId (nStart, nEnd) (A.Several m ss) route

View File

@ -39,7 +39,7 @@ import Utils
-- Multiple Seq links means choice. -- Multiple Seq links means choice.
-- Multiple Par links means a parallel branch. All outgoing par links should have the same identifier, -- Multiple Par links means a parallel branch. All outgoing par links should have the same identifier,
-- and this identifier is unique and matches a later endpar link -- and this identifier is unique and matches a later endpar link
data EdgeLabel = ESeq (Maybe Bool) | EStartPar Int | EEndPar Int deriving (Show, Eq, Ord) data EdgeLabel = ESeq (Maybe Bool) | EStartPar Integer | EEndPar Integer deriving (Show, Eq, Ord)
-- | A type used to build up tree-modifying functions. When given an inner modification function, -- | A type used to build up tree-modifying functions. When given an inner modification function,
-- it returns a modification function for the whole tree. The functions are monadic, to -- it returns a modification function for the whole tree. The functions are monadic, to
@ -92,7 +92,7 @@ type NodesEdges m a b = ([LNode (FNode' b m a)],[LEdge EdgeLabel])
-- * The list of terminator nodes thus far (those with no links from them) -- * The list of terminator nodes thus far (those with no links from them)
data GraphMakerState mAlter a b = GraphMakerState data GraphMakerState mAlter a b = GraphMakerState
{ nextNodeId :: Node { nextNodeId :: Node
, nextParId :: Int , nextParId :: Integer
, graphNodesEdges :: NodesEdges mAlter a b , graphNodesEdges :: NodesEdges mAlter a b
, rootNodes :: [Node] , rootNodes :: [Node]
, termNodes :: [Node] , termNodes :: [Node]
@ -248,18 +248,18 @@ addDummyNode :: (Monad mLabel, Monad mAlter) => Meta -> ASTModifier mAlter a str
-> GraphMaker mLabel mAlter label structType Node -> GraphMaker mLabel mAlter label structType Node
addDummyNode m mod = addNode' m labelDummy m (AlterNothing $ routeId mod) addDummyNode m mod = addNode' m labelDummy m (AlterNothing $ routeId mod)
getNextParEdgeId :: (Monad mLabel, Monad mAlter) => GraphMaker mLabel mAlter label structType Int getNextParEdgeId :: (Monad mLabel, Monad mAlter) => GraphMaker mLabel mAlter label structType Integer
getNextParEdgeId = do st <- get getNextParEdgeId = do st <- get
put $ st {nextParId = nextParId st + 1} put $ st {nextParId = nextParId st + 1}
return $ nextParId st return $ nextParId st
addParEdges :: (Monad mLabel, Monad mAlter) => Int -> (Node,Node) -> [(Node,Node)] -> GraphMaker mLabel mAlter label structType () addParEdges :: (Monad mLabel, Monad mAlter) => Integer -> (Node,Node) -> [(Node,Node)] -> GraphMaker mLabel mAlter label structType ()
addParEdges usePI (s,e) pairs addParEdges usePI (s,e) pairs
= do st <- get = do st <- get
let (nodes,edges) = graphNodesEdges st let (nodes,edges) = graphNodesEdges st
put $ st {graphNodesEdges = (nodes,edges ++ (concatMap (parEdge usePI) pairs))} put $ st {graphNodesEdges = (nodes,edges ++ (concatMap (parEdge usePI) pairs))}
where where
parEdge :: Int -> (Node, Node) -> [LEdge EdgeLabel] parEdge :: Integer -> (Node, Node) -> [LEdge EdgeLabel]
parEdge id (a,z) = [(s,a,(EStartPar id)),(z,e,(EEndPar id))] parEdge id (a,z) = [(s,a,(EStartPar id)),(z,e,(EEndPar id))]
mapMR :: forall inner mAlter mLabel label retType structType. (Monad mLabel, Monad mAlter) => mapMR :: forall inner mAlter mLabel label retType structType. (Monad mLabel, Monad mAlter) =>