Added route-identifiers for blank AST modifiers in the flow graph

flow/FlowGraph.hs

@@ -172,7 +172,7 @@ buildStructuredSeq :: (Monad mLabel, Monad mAlter) => A.Structured A.Process ->
   GraphMaker mLabel mAlter label structType (Node, Node)
 buildStructuredSeq (A.Several m ss) route
   = do nodes <- mapMR (route22 route A.Several) buildStructuredSeq ss
-       joinPairs m nodes
+       joinPairs m route nodes
 buildStructuredSeq (A.Spec m (A.Specification mspec nm (A.Rep mrep rep)) str) route
   = let alter = AlterReplicator $ route22 (route33 (route23 route A.Spec) A.Specification) A.Rep in
     do n <- addNode' (findMeta rep) labelReplicator (nm, rep) alter
@@ -204,7 +204,7 @@ buildStructuredPar pId (nStart, nEnd) (A.Several m ss) route
 buildStructuredPar pId (nStart, nEnd) (A.Spec mstr (A.Specification mspec nm (A.Rep m rep)) str) route
   = let alter = AlterReplicator $ route22 (route33 (route23 route A.Spec) A.Specification) A.Rep in
     do s <- addNode' (findMeta rep) labelReplicator (nm, rep) alter
-       e <- addDummyNode m
+       e <- addDummyNode m route
        pId' <- getNextParEdgeId
        nodes <- buildStructuredPar pId' (s,e) str (route33 route A.Spec)
        case nodes of
@@ -227,7 +227,7 @@ buildStructuredPar pId (nStart, nEnd) (A.Spec m spec str) route
 buildStructuredPar _ _ (A.Only _ p) route = buildProcess p (route22 route A.Only) >>* Right
 buildStructuredPar pId (nStart, nEnd) (A.ProcThen m p str) route
   = do (ps, pe) <- buildProcess p (route23 route A.ProcThen)
-       n <- addDummyNode m
+       n <- addDummyNode m route
        pId' <- getNextParEdgeId
        nodes <- buildStructuredPar pId' (pe, n) str (route33 route A.ProcThen)
        case nodes of
@@ -294,7 +294,7 @@ buildOnlyChoice :: (Monad mLabel, Monad mAlter) => (Node, Node) -> ASTModifier m
 buildOnlyChoice (cPrev, cEnd) route (A.Choice m exp p)
   = do nexp <- addNode' (findMeta exp) labelConditionalExpression exp
                  $ AlterExpression $ route23 route A.Choice
-       nexpf <- addDummyNode m
+       nexpf <- addDummyNode m route
        (nbodys, nbodye) <- buildProcess p $ route33 route A.Choice
        cPrev --> nexp
        addEdge (ESeq $ Just True) nexp nbodys
@@ -308,7 +308,7 @@ buildOnlyOption (cStart, cEnd) route opt
          case opt of
            (A.Option m es p) -> do
              nexpNodes <- mapMR (route23 route A.Option) (\e r -> addNodeExpression (findMeta e) e r >>* mkPair) es
-             (nexps, nexpe) <- joinPairs m nexpNodes
+             (nexps, nexpe) <- joinPairs m route nexpNodes
              (nbodys, nbodye) <- buildProcess p $ route33 route A.Option
              nexpe --> nbodys
              return (nexps,nbodye)
@@ -346,8 +346,8 @@ buildProcess :: (Monad mLabel, Monad mAlter) => A.Process -> ASTModifier mAlter
 buildProcess (A.Seq m s) route
   = buildStructuredSeq s (route22 route A.Seq)
 buildProcess (A.Par m _ s) route
-  = do nStart <- addDummyNode m
-       nEnd <- addDummyNode m
+  = do nStart <- addDummyNode m route
+       nEnd <- addDummyNode m route
        pId <- getNextParEdgeId
        nodes <- buildStructuredPar pId (nStart, nEnd) s (route33 route A.Par)
        case nodes of
@@ -360,7 +360,7 @@ buildProcess (A.Par m _ s) route
 buildProcess (A.While m e p) route
   = do n <- addNode' (findMeta e) labelConditionalExpression e (AlterExpression
          $ route23 route A.While)
-       nAfter <- addDummyNode m
+       nAfter <- addDummyNode m route
        (start, end) <- buildProcess p (route33 route A.While)
        addEdge (ESeq $ Just True) n start
        addEdge (ESeq $ Just False) n nAfter
@@ -368,17 +368,17 @@ buildProcess (A.While m e p) route
        return (n, nAfter)
 buildProcess (A.Case m e s) route
   = do nStart <- addNodeExpression (findMeta e) e (route23 route A.Case)
-       nEnd <- addDummyNode m
+       nEnd <- addDummyNode m route
        buildStructuredCase (nStart,nEnd) s (route33 route A.Case)
        return (nStart, nEnd)
 buildProcess (A.If m s) route
-  = do nStart <- addDummyNode m
-       nEnd <- addDummyNode m
+  = do nStart <- addDummyNode m route
+       nEnd <- addDummyNode m route
        buildStructuredIf (nStart, nEnd) s (route22 route A.If)
        return (nStart, nEnd)
 buildProcess (A.Alt m _ s) route
-  = do nStart <- addDummyNode m
-       nEnd <- addDummyNode m
+  = do nStart <- addDummyNode m route
+       nEnd <- addDummyNode m route
        specNodes <- buildJustSpecs s (route33 route A.Alt)
        (nStart', nEnd') <- case specNodes of
          Just ((nInStart, nInEnd), (nOutStart, nOutEnd)) ->

flow/FlowGraphTest.hs

@@ -760,7 +760,7 @@ pickFuncId g = map (applyFunc . getFunc) (labNodes g)
     applyFunc (AlterExpressionList f) = routeModify f return
     applyFunc (AlterReplicator f) = routeModify f return
     applyFunc (AlterSpec f) = routeModify f return
-    applyFunc (AlterNothing) = return
+    applyFunc (AlterNothing _) = return
 
 -- | Given a flow-graph, it returns a list of the meta-tag replacement alteration functions,
 -- for each meta-tag (i.e. each node).
@@ -777,7 +777,7 @@ pickFuncRep gr = Map.fromList $ filter ((/= emptyMeta) . fst) $ map (helpApplyFu
     applyFunc (m,AlterExpressionList f) = routeModify f (g m)
     applyFunc (m,AlterReplicator f) = routeModify f (g m)
     applyFunc (m,AlterSpec f) = routeModify f (g m)
-    applyFunc (m,AlterNothing) = return
+    applyFunc (m,AlterNothing _) = return
     
     g m = gmapM (mkM $ replaceM m (replaceMeta m))
 

flow/FlowUtils.hs

@@ -57,7 +57,7 @@ data AlterAST m structType =
  |AlterExpressionList (ASTModifier m A.ExpressionList structType)
  |AlterReplicator (ASTModifier m A.Replicator structType)
  |AlterSpec (ASTModifier m A.Specification structType)
- |AlterNothing
+ |AlterNothing [Int]
 
 data Monad mAlter => FNode' structType mAlter label
   = Node (Meta, label, AlterAST mAlter structType)
@@ -122,6 +122,18 @@ getNodeData (Node (_,d,_)) = d
 getNodeFunc :: Monad m => FNode' b m a -> AlterAST m b
 getNodeFunc (Node (_,_,f)) = f
 
+getNodeRouteId :: Monad m => FNode' b m a -> [Int]
+getNodeRouteId = get . getNodeFunc
+  where
+    get (AlterProcess f) = routeId f
+    get (AlterAlternative f) = routeId f
+    get (AlterArguments f) = routeId f
+    get (AlterExpression f) = routeId f
+    get (AlterExpressionList f) = routeId f
+    get (AlterReplicator f) = routeId f
+    get (AlterSpec f) = routeId f
+    get (AlterNothing r) = r
+
 makeTestNode :: Monad m => Meta -> a -> FNode m a
 makeTestNode m d = Node (m,d,undefined)
 
@@ -199,8 +211,9 @@ addNodeExpression m e r = addNode' m labelExpression e (AlterExpression r)
 addNodeExpressionList :: (Monad mLabel, Monad mAlter) => Meta -> A.ExpressionList -> (ASTModifier mAlter A.ExpressionList structType) -> GraphMaker mLabel mAlter label structType Node
 addNodeExpressionList m e r = addNode' m labelExpressionList e (AlterExpressionList r)
 
-addDummyNode :: (Monad mLabel, Monad mAlter) => Meta -> GraphMaker mLabel mAlter label structType Node
-addDummyNode m = addNode' m labelDummy m AlterNothing
+addDummyNode :: (Monad mLabel, Monad mAlter) => Meta -> ASTModifier mAlter a structType
+  -> GraphMaker mLabel mAlter label structType Node
+addDummyNode m mod = addNode' m labelDummy m (AlterNothing $ routeId mod)
 
 getNextParEdgeId :: (Monad mLabel, Monad mAlter) => GraphMaker mLabel mAlter label structType Int
 getNextParEdgeId = do (a, pi, b, c, d) <- get
@@ -242,9 +255,10 @@ nonEmpty :: Either Bool [(Node,Node)] -> Bool
 nonEmpty (Left hadNodes) = hadNodes
 nonEmpty (Right nodes) = not (null nodes)
     
-joinPairs :: (Monad mLabel, Monad mAlter) => Meta -> [(Node, Node)] -> GraphMaker mLabel mAlter label structType (Node, Node)
-joinPairs m [] = addDummyNode m >>* mkPair
-joinPairs m nodes = do sequence_ $ mapPairs (\(_,s) (e,_) -> addEdge (ESeq
-                         Nothing) s e) nodes
-                       return (fst (head nodes), snd (last nodes))
+joinPairs :: (Monad mLabel, Monad mAlter) => Meta -> ASTModifier mAlter a structType
+  -> [(Node, Node)] -> GraphMaker mLabel mAlter label structType (Node, Node)
+joinPairs m mod [] = addDummyNode m mod >>* mkPair
+joinPairs m mod nodes
+  = do sequence_ $ mapPairs (\(_,s) (e,_) -> addEdge (ESeq Nothing) s e) nodes
+       return (fst (head nodes), snd (last nodes))