diff --git a/flow/FlowGraph.hs b/flow/FlowGraph.hs index f5a916f..72d9a9a 100644 --- a/flow/FlowGraph.hs +++ b/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)) -> diff --git a/flow/FlowGraphTest.hs b/flow/FlowGraphTest.hs index 8d91968..dd8dba9 100644 --- a/flow/FlowGraphTest.hs +++ b/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)) diff --git a/flow/FlowUtils.hs b/flow/FlowUtils.hs index 72cff63..5186781 100644 --- a/flow/FlowUtils.hs +++ b/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))