From 3a5881c14f7ff356979c1fe2380f122692d2e07d Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Fri, 6 Jun 2008 18:34:50 +0000 Subject: [PATCH] Added an optional flag to the ESeq edge label, ready to be used to indicate whether a condition was true on this branch or not --- checks/UsageCheckTest.hs | 40 ++++++++++--------- flow/FlowGraph.hs | 2 +- flow/FlowGraphTest.hs | 86 ++++++++++++++++++++++------------------ flow/FlowUtils.hs | 5 ++- 4 files changed, 72 insertions(+), 61 deletions(-) diff --git a/checks/UsageCheckTest.hs b/checks/UsageCheckTest.hs index 6df131e..cda881e 100644 --- a/checks/UsageCheckTest.hs +++ b/checks/UsageCheckTest.hs @@ -134,12 +134,14 @@ instance Warn TestM where buildTestFlowGraph :: [(Int, [Var], [Var])] -> [(Int, Int, EdgeLabel)] -> Int -> Int -> String -> FlowGraph TestM UsageLabel buildTestFlowGraph ns es start end v = mkGraph - ([(-1,makeTestNode emptyMeta $ Usage Nothing (Just $ ScopeIn False v) emptyVars),(-2,makeTestNode emptyMeta $ Usage Nothing (Just $ ScopeOut v) emptyVars)] ++ (map transNode ns)) - ([(-1,start,ESeq),(end,-2,ESeq)] ++ es) + ([(-1,makeTestNode emptyMeta $ Usage Nothing (Just $ ScopeIn False v) Nothing + emptyVars),(-2,makeTestNode emptyMeta $ Usage Nothing (Just $ ScopeOut v) Nothing + emptyVars)] ++ (map transNode ns)) + ([(-1,start,ESeq Nothing),(end,-2,ESeq Nothing)] ++ es) where transNode :: (Int, [Var], [Var]) -> (Int, FNode TestM UsageLabel) - transNode (n,r,w) = (n,makeTestNode emptyMeta (Usage Nothing Nothing $ vars r (zip - w $ repeat Nothing) [])) + transNode (n,r,w) = (n,makeTestNode emptyMeta (Usage Nothing Nothing Nothing + $ vars r (zip w $ repeat Nothing) [])) testInitVar :: Test testInitVar = TestList @@ -155,9 +157,9 @@ testInitVar = TestList ,testInitVarFail 3 [(0,[variable "x"],[variable "x"])] [] 0 0 "x" -- Two nodes, x written to then read - ,testInitVarPass 10 [(0,[],[variable "x"]), (1,[variable "x"],[])] [(0,1,ESeq)] 0 1 "x" + ,testInitVarPass 10 [(0,[],[variable "x"]), (1,[variable "x"],[])] [(0,1,ESeq Nothing)] 0 1 "x" -- Two nodes, x read then written to (FAIL) - ,testInitVarFail 11 [(0,[],[variable "x"]), (1,[variable "x"],[])] [(1,0,ESeq)] 1 0 "x" + ,testInitVarFail 11 [(0,[],[variable "x"]), (1,[variable "x"],[])] [(1,0,ESeq Nothing)] 1 0 "x" -- As test 10 (x written to then read) but using the par edges. ,testInitVarPass 13 [(0,[],[variable "x"]), (1,[variable "x"],[])] [(0,1,EStartPar 0)] 0 1 "x" ,testInitVarPass 14 [(0,[],[variable "x"]), (1,[variable "x"],[])] [(0,1,EEndPar 0)] 0 1 "x" @@ -165,25 +167,25 @@ testInitVar = TestList -- Diamond tests (0 branches to 1 and 2, which both merge to 3): -- x written to in 0 and 1, then read in 3 ,testInitVarPass 20 [(0,[],[]),(1,[],[variable "x"]), (2,[],[variable "x"]), (3,[variable "x"],[])] - [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x" + [(0,1,ESeq Nothing),(0,2,ESeq Nothing),(1,3,ESeq Nothing),(2,3,ESeq Nothing)] 0 3 "x" -- x written to only in 2 then read in 3 (FAIL) ,testInitVarFail 21 [(0,[],[]),(1,[],[]), (2,[],[variable "x"]), (3,[variable "x"],[])] - [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x" + [(0,1,ESeq Nothing),(0,2,ESeq Nothing),(1,3,ESeq Nothing),(2,3,ESeq Nothing)] 0 3 "x" -- x definitely written to in 2, but not 1 (FAIL) ,testInitVarFail 22 [(0,[],[]),(1,[],[]), (2,[],[variable "x"]), (3,[variable "x"],[])] - [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x" + [(0,1,ESeq Nothing),(0,2,ESeq Nothing),(1,3,ESeq Nothing),(2,3,ESeq Nothing)] 0 3 "x" -- like test 21, but the link missing from 1 to 3, so test will pass ,testInitVarPass 23 [(0,[],[]),(1,[],[]), (2,[],[variable "x"]), (3,[variable "x"],[])] - [(0,1,ESeq),(0,2,ESeq),(2,3,ESeq)] 0 3 "x" + [(0,1,ESeq Nothing),(0,2,ESeq Nothing),(2,3,ESeq Nothing)] 0 3 "x" -- variable written to in 0, read in 3 ,testInitVarPass 24 [(0,[],[variable "x"]),(1,[],[]), (2,[],[]), (3,[variable "x"],[])] - [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x" + [(0,1,ESeq Nothing),(0,2,ESeq Nothing),(1,3,ESeq Nothing),(2,3,ESeq Nothing)] 0 3 "x" -- variable never written to, but read in 3 ,testInitVarFail 25 [(0,[],[]),(1,[],[]), (2,[],[]), (3,[variable "x"],[])] - [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x" + [(0,1,ESeq Nothing),(0,2,ESeq Nothing),(1,3,ESeq Nothing),(2,3,ESeq Nothing)] 0 3 "x" -- variable written to in 2 and 3, but read in 1 (FAIL): ,testInitVarFail 26 [(0,[],[]),(1,[variable "x"],[]), (2,[],[variable "x"]), (3,[],[variable "x"])] - [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x" + [(0,1,ESeq Nothing),(0,2,ESeq Nothing),(1,3,ESeq Nothing),(2,3,ESeq Nothing)] 0 3 "x" -- Test parallel diamonds: -- written to in 1 and 2, read in 3 @@ -210,22 +212,22 @@ testInitVar = TestList -- Test loops (0 -> 1, 1 -> 2 -> 3 -> 1, 1 -> 4) -- Loop, nothing happens: ,testInitVarPass 100 [(0,[],[]),(1,[],[]),(2,[],[]),(3,[],[]),(4,[],[])] - [(0,1,ESeq), (1,2,ESeq), (2,3,ESeq), (3,1,ESeq), (1,4,ESeq)] 0 4 "x" + [(0,1,ESeq Nothing), (1,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (1,4,ESeq Nothing)] 0 4 "x" -- Loop, written to before the loop, read afterwards: ,testInitVarPass 101 [(0,[],[variable "x"]),(1,[],[]),(2,[],[]),(3,[],[]),(4,[variable "x"],[])] - [(0,1,ESeq), (1,2,ESeq), (2,3,ESeq), (3,1,ESeq), (1,4,ESeq)] 0 4 "x" + [(0,1,ESeq Nothing), (1,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (1,4,ESeq Nothing)] 0 4 "x" -- Loop, written to before the loop, read during the loop ,testInitVarPass 102 [(0,[],[variable "x"]),(1,[],[]),(2,[],[]),(3,[variable "x"],[]),(4,[],[])] - [(0,1,ESeq), (1,2,ESeq), (2,3,ESeq), (3,1,ESeq), (1,4,ESeq)] 0 4 "x" + [(0,1,ESeq Nothing), (1,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (1,4,ESeq Nothing)] 0 4 "x" -- Loop, written to during the loop, read afterwards (FAIL - loop might not be executed) ,testInitVarFail 103 [(0,[],[]),(1,[],[]),(2,[],[variable "x"]),(3,[],[]),(4,[variable "x"],[])] - [(0,1,ESeq), (1,2,ESeq), (2,3,ESeq), (3,1,ESeq), (1,4,ESeq)] 0 4 "x" + [(0,1,ESeq Nothing), (1,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (1,4,ESeq Nothing)] 0 4 "x" -- Loop, written to and then read during the loop: ,testInitVarPass 104 [(0,[],[]),(1,[],[]),(2,[],[variable "x"]),(3,[variable "x"],[]),(4,[],[])] - [(0,1,ESeq), (1,2,ESeq), (2,3,ESeq), (3,1,ESeq), (1,4,ESeq)] 0 4 "x" + [(0,1,ESeq Nothing), (1,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (1,4,ESeq Nothing)] 0 4 "x" -- Loop, read then written to during the loop (FAIL): ,testInitVarFail 105 [(0,[],[]),(1,[],[]),(2,[variable "x"],[]),(3,[],[variable "x"]),(4,[],[])] - [(0,1,ESeq), (1,2,ESeq), (2,3,ESeq), (3,1,ESeq), (1,4,ESeq)] 0 4 "x" + [(0,1,ESeq Nothing), (1,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (1,4,ESeq Nothing)] 0 4 "x" -- TODO work out (and test) par loops -- TODO test dereferenced variables diff --git a/flow/FlowGraph.hs b/flow/FlowGraph.hs index a66387e..feefc3a 100644 --- a/flow/FlowGraph.hs +++ b/flow/FlowGraph.hs @@ -57,7 +57,7 @@ import Utils -- Helper for add a standard sequential edge: (-->) :: (Monad mLabel, Monad mAlter) => Node -> Node -> GraphMaker mLabel mAlter label structType () -(-->) = addEdge ESeq +(-->) = addEdge (ESeq Nothing) addSpecNodes :: (Monad mAlter, Monad mLabel, Data a) => A.Specification -> ASTModifier mAlter (A.Structured a) structType -> GraphMaker mLabel mAlter label structType (Node, Node) addSpecNodes spec route diff --git a/flow/FlowGraphTest.hs b/flow/FlowGraphTest.hs index 13cacae..c20ffff 100644 --- a/flow/FlowGraphTest.hs +++ b/flow/FlowGraphTest.hs @@ -174,35 +174,35 @@ testSeq = TestLabel "testSeq" $ TestList testSeq' 0 [(0,m1)] [] (A.Several m1 []) ,testSeq' 1 [(0,m2)] [] (A.Only m1 sm2) ,testSeq' 2 [(0,m3)] [] (A.Several m1 [A.Only m2 sm3]) - ,testSeq' 3 [(0,m3),(1,m5)] [(0,1,ESeq)] (A.Several m1 [A.Only m2 sm3,A.Only m4 sm5]) - ,testSeq' 4 [(0,m3),(1,m5),(2,m7)] [(0,1,ESeq),(1,2,ESeq)] (A.Several m1 [A.Only m2 sm3,A.Only m4 sm5,A.Only m6 sm7]) - ,testSeq' 5 [(0,m3),(1,m5)] [(0,1,ESeq)] (A.Several m1 [A.Several m1 [A.Only m2 sm3],A.Several m1 [A.Only m4 sm5]]) - ,testSeq' 6 [(0,m3),(1,m5),(2,m7),(3,m9)] [(0,1,ESeq),(1,2,ESeq),(2,3,ESeq)] + ,testSeq' 3 [(0,m3),(1,m5)] [(0,1,ESeq Nothing)] (A.Several m1 [A.Only m2 sm3,A.Only m4 sm5]) + ,testSeq' 4 [(0,m3),(1,m5),(2,m7)] [(0,1,ESeq Nothing),(1,2,ESeq Nothing)] (A.Several m1 [A.Only m2 sm3,A.Only m4 sm5,A.Only m6 sm7]) + ,testSeq' 5 [(0,m3),(1,m5)] [(0,1,ESeq Nothing)] (A.Several m1 [A.Several m1 [A.Only m2 sm3],A.Several m1 [A.Only m4 sm5]]) + ,testSeq' 6 [(0,m3),(1,m5),(2,m7),(3,m9)] [(0,1,ESeq Nothing),(1,2,ESeq Nothing),(2,3,ESeq Nothing)] (A.Several m1 [A.Several m1 [A.Only m2 sm3,A.Only m4 sm5,A.Only m6 sm7], A.Only m8 sm9]) - ,testSeq' 10 [(0,m1),(1,m4),(100,sub m1 100)] [(0,1,ESeq),(1,100,ESeq)] (A.Spec mU (someSpec m1) $ A.Only m3 sm4) + ,testSeq' 10 [(0,m1),(1,m4),(100,sub m1 100)] [(0,1,ESeq Nothing),(1,100,ESeq Nothing)] (A.Spec mU (someSpec m1) $ A.Only m3 sm4) ,testSeq'' 11 [(1,m1),(3,m4),(5,m5),(7,m7),(9,m10),(101,sub m1 100),(105,sub m5 100),(107,sub m7 100)] [1] - [(1,3,ESeq),(3,101,ESeq),(101,5,ESeq),(5,7,ESeq),(7,9,ESeq),(9,107,ESeq),(107,105,ESeq)] + [(1,3,ESeq Nothing),(3,101,ESeq Nothing),(101,5,ESeq Nothing),(5,7,ESeq Nothing),(7,9,ESeq Nothing),(9,107,ESeq Nothing),(107,105,ESeq Nothing)] (A.Several m11 [A.Spec mU (someSpec m1) $ A.Only m3 sm4,A.Spec mU (someSpec m5) $ A.Spec mU (someSpec m7) $ A.Only m9 sm10]) - ,testSeq' 12 [(0,m1),(4,m4),(100,sub m1 100)] [(0,4,ESeq),(4,100,ESeq)] (A.Spec mU (someSpec m1) $ A.Several m4 []) + ,testSeq' 12 [(0,m1),(4,m4),(100,sub m1 100)] [(0,4,ESeq Nothing),(4,100,ESeq Nothing)] (A.Spec mU (someSpec m1) $ A.Several m4 []) -- Replicated SEQ: - ,testSeq' 100 [(0,m10), (1,m3), (2,m5)] [(0,1,ESeq), (1,2,ESeq), (2,0,ESeq)] + ,testSeq' 100 [(0,m10), (1,m3), (2,m5)] [(0,1,ESeq Nothing), (1,2,ESeq Nothing), (2,0,ESeq Nothing)] (rep m10 $ A.Several m1 [A.Only m2 sm3,A.Only m4 sm5]) - ,testSeq'' 101 [(0,m8), (1,m3), (2,m5),(3,m9),(4,m11)] [3] [(3,0,ESeq),(0,1,ESeq), (1,2,ESeq), (2,0,ESeq),(0,4,ESeq)] + ,testSeq'' 101 [(0,m8), (1,m3), (2,m5),(3,m9),(4,m11)] [3] [(3,0,ESeq Nothing),(0,1,ESeq Nothing), (1,2,ESeq Nothing), (2,0,ESeq Nothing),(0,4,ESeq Nothing)] (A.Only mU $ A.Seq m6 $ A.Several m7 [A.Only mU sm9 ,(rep m8 $ A.Several m1 [A.Only m2 sm3,A.Only m4 sm5]) ,A.Only mU sm11]) - ,testSeq' 102 [(0,m10), (1,m1)] [(0,1,ESeq), (1,0,ESeq)] + ,testSeq' 102 [(0,m10), (1,m1)] [(0,1,ESeq Nothing), (1,0,ESeq Nothing)] (rep m10 $ A.Several m1 []) - ,testSeq' 103 [(1,m10), (0,m1), (2,m2), (3,m3)] [(0,1,ESeq),(1,3,ESeq), (3,1,ESeq),(1,2,ESeq)] + ,testSeq' 103 [(1,m10), (0,m1), (2,m2), (3,m3)] [(0,1,ESeq Nothing),(1,3,ESeq Nothing), (3,1,ESeq Nothing),(1,2,ESeq Nothing)] (A.Several mU [A.Only mU sm1, (rep m10 $ A.Several m3 []), A.Only mU sm2]) ] @@ -216,7 +216,7 @@ testSeq = TestLabel "testSeq" $ TestList testPar :: Test testPar = TestLabel "testPar" $ TestList [ - testPar' 0 [] [(0,99,ESeq)] (A.Several m1 []) + testPar' 0 [] [(0,99,ESeq Nothing)] (A.Several m1 []) ,testPar' 1 [(1,m2)] [(0,1,EStartPar 0), (1,99,EEndPar 0)] (A.Only m1 sm2) ,testPar' 2 [(1,m3)] [(0,1,EStartPar 0), (1,99,EEndPar 0)] (A.Several m1 [A.Only m2 sm3]) ,testPar' 3 [(1, m3), (2, m5)] @@ -234,14 +234,14 @@ testPar = TestLabel "testPar" $ TestList (A.Several m1 [A.Several m10 [A.Only m2 sm3,A.Only m4 sm5,A.Only m6 sm7], A.Only m8 sm9]) ,testPar' 10 [(1, m3), (2, m5), (6, m6),(106,sub m6 100)] - [(0,6,EStartPar 0),(6,1,ESeq),(1,106,ESeq),(106,99,EEndPar 0), (0,2,EStartPar 0), (2,99,EEndPar 0)] + [(0,6,EStartPar 0),(6,1,ESeq Nothing),(1,106,ESeq Nothing),(106,99,EEndPar 0), (0,2,EStartPar 0), (2,99,EEndPar 0)] (A.Several m1 [A.Spec mU (someSpec m6) $ A.Only m2 sm3,A.Only m4 sm5]) ,testPar' 11 [(1, m3), (2, m5), (3,m7), (6, m6),(106,sub m6 100)] [(0,6,EStartPar 0),(6,1,EStartPar 1),(6,2,EStartPar 1),(1,106,EEndPar 1),(2,106,EEndPar 1) ,(106,99,EEndPar 0), (0,3,EStartPar 0), (3,99,EEndPar 0)] (A.Several m1 [A.Spec mU (someSpec m6) $ A.Several mU [A.Only mU sm3, A.Only mU sm5], A.Only mU sm7]) - ,testPar' 20 [(1,m1),(100,sub m1 100)] [(0,1,EStartPar 0),(1,100,ESeq),(100,99,EEndPar 0)] (A.Spec mU (someSpec m1) $ A.Several m4 []) + ,testPar' 20 [(1,m1),(100,sub m1 100)] [(0,1,EStartPar 0),(1,100,ESeq Nothing),(100,99,EEndPar 0)] (A.Spec mU (someSpec m1) $ A.Several m4 []) --TODO test nested pars @@ -266,7 +266,7 @@ testPar = TestLabel "testPar" $ TestList ,(rep m5 $ A.Several mU [A.Only mU sm6,A.Only mU sm7])]) ,testPar' 102 [(1,m6), (4, sub m6 1)] - [(0,1,EStartPar 0), (1,4,ESeq), (4,99,EEndPar 0)] + [(0,1,EStartPar 0), (1,4,ESeq Nothing), (4,99,EEndPar 0)] (rep m6 $ A.Several mU []) ] where @@ -276,26 +276,26 @@ testPar = TestLabel "testPar" $ TestList testWhile :: Test testWhile = TestLabel "testWhile" $ TestList [ - testGraph "testWhile 0" [(0,m0), (1,m1)] [0] [(0,1,ESeq), (1,0,ESeq)] (A.While mU (A.True m0) sm1) - ,testGraph "testWhile 1" [(2,m2), (3, m3), (5, m5)] [2] [(2,3,ESeq), (3,2,ESeq), (2,5,ESeq)] + testGraph "testWhile 0" [(0,m0), (1,m1)] [0] [(0,1,ESeq Nothing), (1,0,ESeq Nothing)] (A.While mU (A.True m0) sm1) + ,testGraph "testWhile 1" [(2,m2), (3, m3), (5, m5)] [2] [(2,3,ESeq Nothing), (3,2,ESeq Nothing), (2,5,ESeq Nothing)] (A.Seq m0 $ A.Several m1 [A.Only m9 $ A.While mU (A.True m2) sm3,A.Only m4 sm5]) - ,testGraph "testWhile 2" [(2,m2), (3, m3), (5, m5), (7, m7)] [7] [(7,2,ESeq), (2,3,ESeq), (3,2,ESeq), (2,5,ESeq)] + ,testGraph "testWhile 2" [(2,m2), (3, m3), (5, m5), (7, m7)] [7] [(7,2,ESeq Nothing), (2,3,ESeq Nothing), (3,2,ESeq Nothing), (2,5,ESeq Nothing)] (A.Seq m0 $ A.Several m1 [A.Only m6 sm7,A.Only m9 $ A.While mU (A.True m2) sm3,A.Only m4 sm5]) - ,testGraph "testWhile 3" [(2,m2), (3, m3), (5, m5), (7, m7), (9, m9)] [7] [(7,2,ESeq), (2,3,ESeq), (3,9,ESeq), (9,2,ESeq), (2,5,ESeq)] + ,testGraph "testWhile 3" [(2,m2), (3, m3), (5, m5), (7, m7), (9, m9)] [7] [(7,2,ESeq Nothing), (2,3,ESeq Nothing), (3,9,ESeq Nothing), (9,2,ESeq Nothing), (2,5,ESeq Nothing)] (A.Seq m0 $ A.Several m1 [A.Only m6 sm7,A.Only mU $ A.While mU (A.True m2) $ A.Seq mU $ A.Several mU [A.Only mU sm3,A.Only mU sm9],A.Only m4 sm5]) ] testCase :: Test testCase = TestLabel "testCase" $ TestList [ - testGraph "testCase 0" [(0,m10),(1,m0),(2,m3)] [0] [(0,2,ESeq),(2,1,ESeq)] (A.Case m0 (A.True m10) $ cases m1 [A.Else m2 sm3]) + testGraph "testCase 0" [(0,m10),(1,m0),(2,m3)] [0] [(0,2,ESeq Nothing),(2,1,ESeq Nothing)] (A.Case m0 (A.True m10) $ cases m1 [A.Else m2 sm3]) ,testGraph "testCase 1" [(0,m10),(1,m0),(2,m2),(3,m3)] [0] - [(0,2,ESeq),(2,3,ESeq),(3,1,ESeq)] + [(0,2,ESeq Nothing),(2,3,ESeq Nothing),(3,1,ESeq Nothing)] (A.Case m0 (A.True m10) $ cases mU [A.Option mU [A.True m2] sm3]) ,testGraph "testCase 2" [(0,m10),(1,m0), (2,m2), (3,m3), (4, m4), (5,m5)] [0] - [(0,2,ESeq), (2,3,ESeq), (3,1,ESeq), (0,4,ESeq), (4,5,ESeq), (5,1,ESeq)] + [(0,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (0,4,ESeq Nothing), (4,5,ESeq Nothing), (5,1,ESeq Nothing)] (A.Case m0 (A.True m10) $ cases m1 [A.Option mU [A.True m2] sm3, A.Option mU [A.True m4] sm5]) --TODO test case statements that have specs ] @@ -309,26 +309,34 @@ testIf = TestLabel "testIf" $ TestList -- Remember that the last branch of an IF doesn't link to the end of the IF, because -- occam stops if no option is found. - testGraph "testIf 0" [(0,m0), (1,sub m0 1), (2,m2), (3,m3)] [0] [(0,2,ESeq),(2,3,ESeq),(3,1,ESeq)] + testGraph "testIf 0" [(0,m0), (1,sub m0 1), (2,m2), (3,m3)] [0] [(0,2,ESeq Nothing),(2,3,ESeq Nothing),(3,1,ESeq Nothing)] (A.If m0 $ ifs mU [(A.True m2, sm3)]) ,testGraph "testIf 1" [(0,m0), (1,sub m0 1), (2,m2), (3,m3), (4,m4), (5, m5)] [0] - [(0,2,ESeq),(2,3,ESeq),(3,1,ESeq), (2,4,ESeq),(4,5,ESeq),(5,1,ESeq)] + [(0,2,ESeq Nothing),(2,3,ESeq Nothing),(3,1,ESeq Nothing), (2,4,ESeq Nothing),(4,5,ESeq Nothing),(5,1,ESeq Nothing)] (A.If m0 $ ifs mU [(A.True m2, sm3), (A.True m4, sm5)]) ,testGraph "testIf 2" [(0,m0), (1,sub m0 1), (2,m2), (3,m3), (4,m4), (5, m5), (6, m6), (7, m7)] [0] - [(0,2,ESeq),(2,3,ESeq),(3,1,ESeq), (2,4,ESeq),(4,5,ESeq),(5,1,ESeq), (4,6,ESeq),(6,7,ESeq),(7,1,ESeq)] + [(0,2,ESeq Nothing),(2,3,ESeq Nothing),(3,1,ESeq Nothing), (2,4,ESeq Nothing),(4,5,ESeq Nothing),(5,1,ESeq Nothing), (4,6,ESeq Nothing),(6,7,ESeq Nothing),(7,1,ESeq Nothing)] (A.If m0 $ ifs mU [(A.True m2, sm3), (A.True m4, sm5), (A.True m6, sm7)]) +{- + -- TODO test specs in Ifs + #error + testGraph "testIf 3" [(0,m0), (1,sub m0 1), (2,m2), (3,m3), (4,m4), (5, sub m4 1), (6, sub m4 2)] [0] + [(0,4,ESeq Nothing),(4,2,ESeq Nothing),(2,3,ESeq Nothing),(3,5,ESeq Nothing), (5,1,ESeq Nothing), ] + (A.If m0 $ A.Spec mU (someSpec m4) $ ifs mU [(A.True m2, sm3)]) +-} + ,testGraph "testIf 10" [(0,m0), (1,sub m0 1), (2,m2), (3,m3), (5, m5)] [0] - [(0,5,ESeq), (5,2,ESeq), (2,3,ESeq), (3,1,ESeq), (2, 5, ESeq)] + [(0,5,ESeq Nothing), (5,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (2, 5, ESeq Nothing)] (A.If m0 $ rep m5 $ ifs mU [(A.True m2, sm3)]) ,testGraph "testIf 11" [(0,m0), (1,sub m0 1), (2,m2), (3,m3), (5, m5), (6, m6), (7, m7)] [0] - [(0,5,ESeq), (5,2,ESeq), (2,3,ESeq), (3,1,ESeq), (2, 6, ESeq), (6,7,ESeq), (7,1,ESeq), (6, 5, ESeq)] + [(0,5,ESeq Nothing), (5,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (2, 6, ESeq Nothing), (6,7,ESeq Nothing), (7,1,ESeq Nothing), (6, 5, ESeq Nothing)] (A.If m0 $ rep m5 $ ifs mU [(A.True m2, sm3), (A.True m6, sm7)]) ,testGraph "testIf 12" [(0,m0), (1,sub m0 1), (2,m2), (3,m3), (5, m5), (6, m6), (7, m7), (8, m8), (9, m9)] [0] - [(0,5,ESeq), (5,2,ESeq), (2,3,ESeq), (3,1,ESeq), (2, 6, ESeq), (6,7,ESeq), (7,1,ESeq), (6, 5, ESeq), (5,8,ESeq), - (8,9,ESeq), (9,1,ESeq)] + [(0,5,ESeq Nothing), (5,2,ESeq Nothing), (2,3,ESeq Nothing), (3,1,ESeq Nothing), (2, 6, ESeq Nothing), (6,7,ESeq Nothing), (7,1,ESeq Nothing), (6, 5, ESeq Nothing), (5,8,ESeq Nothing), + (8,9,ESeq Nothing), (9,1,ESeq Nothing)] (A.If m0 $ A.Several mU [rep m5 $ ifs mU [(A.True m2, sm3), (A.True m6, sm7)] , ifs mU [(A.True m8, sm9)]]) ] @@ -340,17 +348,17 @@ testProcFuncSpec :: Test testProcFuncSpec = TestLabel "testProcFuncSpec" $ TestList [ -- Single spec of process (with SKIP body) in AST (not connected up): - testGraph' "testProcFuncSpec 0" [(0, m0), (5,m5)] [5] [(5,0,ESeq)] + testGraph' "testProcFuncSpec 0" [(0, m0), (5,m5)] [5] [(5,0,ESeq Nothing)] (A.Spec mU (A.Specification m1 undefined $ A.Proc m5 undefined undefined sm0) $ A.Several mU []) -- Single spec of process (with body with SEQ SKIP SKIP): - ,testGraph' "testProcFuncSpec 1" [(0, m3), (4,m5), (9,m9)] [9] ([(9,0,ESeq), (0,4,ESeq)]) + ,testGraph' "testProcFuncSpec 1" [(0, m3), (4,m5), (9,m9)] [9] ([(9,0,ESeq Nothing), (0,4,ESeq Nothing)]) (A.Spec mU (A.Specification m6 undefined $ A.Proc m9 undefined undefined $ A.Seq m0 $ A.Several m1 [A.Only m2 sm3,A.Only m4 sm5] ) $ A.Several mU []) -- Nested spec of process (with bodies with SEQ SKIP SKIP): ,testGraph' "testProcFuncSpec 2" [(3,m2),(4,m3),(5,m4),(6,m5), (10,m10), (11, m11)] [10,11] - ([(10,3,ESeq), (3,4,ESeq)] ++ [(11,5,ESeq), (5,6,ESeq)]) + ([(10,3,ESeq Nothing), (3,4,ESeq Nothing)] ++ [(11,5,ESeq Nothing), (5,6,ESeq Nothing)]) (A.Spec mU (A.Specification m6 undefined $ A.Proc m10 undefined undefined $ A.Seq mU $ A.Several mU [A.Only mU sm2,A.Only mU sm3] ) $ @@ -360,7 +368,7 @@ testProcFuncSpec = TestLabel "testProcFuncSpec" $ TestList $ A.Several mU []) -- Single spec of process (with SKIP body) in a SEQ (connected up): - ,testGraph "testProcFuncSpec 10" [(0, m0),(1,m1),(2,sub m1 100), (3, m3), (5,m5)] [1,5] [(5,0,ESeq), (1,3,ESeq), (3,2,ESeq)] + ,testGraph "testProcFuncSpec 10" [(0, m0),(1,m1),(2,sub m1 100), (3, m3), (5,m5)] [1,5] [(5,0,ESeq Nothing), (1,3,ESeq Nothing), (3,2,ESeq Nothing)] (A.Seq mU $ A.Spec mU (A.Specification m1 undefined $ A.Proc m5 undefined undefined sm0) $ A.Several m3 []) ] @@ -372,25 +380,25 @@ testAlt = TestLabel "testAlt" $ TestList -- branching to a guard, then doing the guard and body, then scoping everything out. testGraph "testAlt 0" [(0, m1), (1, sub m1 1), (4,m4), (5,m5)] [0] - [(0,4,ESeq), (4,5,ESeq), (5,1,ESeq)] + [(0,4,ESeq Nothing), (4,5,ESeq Nothing), (5,1,ESeq Nothing)] (A.Alt m1 False $ A.Only mU guard45) ,testGraph "testAlt 1" [(0, m1), (1, sub m1 1), (4,m4), (5,m5), (6, m6), (7, m7)] [0] - [(0,4,ESeq), (0,6,ESeq), (4,5,ESeq), (6,7,ESeq), (5,1,ESeq), (7,1,ESeq)] + [(0,4,ESeq Nothing), (0,6,ESeq Nothing), (4,5,ESeq Nothing), (6,7,ESeq Nothing), (5,1,ESeq Nothing), (7,1,ESeq Nothing)] (A.Alt m1 False $ A.Several mU $ map (A.Only mU) [guard45, guard67]) ,testGraph "testAlt 2" [(0, m1), (1, sub m1 1), (4,m4), (5,m5), (8,m8), (18, sub m8 100)] [0] - [(0,8,ESeq), (8,4,ESeq), (4,5,ESeq), (5,18,ESeq), (18,1,ESeq)] + [(0,8,ESeq Nothing), (8,4,ESeq Nothing), (4,5,ESeq Nothing), (5,18,ESeq Nothing), (18,1,ESeq Nothing)] (A.Alt m1 False $ spec8 $ A.Only mU guard45) ,testGraph "testAlt 3" [(0, m1), (1, sub m1 1), (4,m4), (5,m5), (8,m8), (18, sub m8 100), (9,m9), (19, sub m9 100)] [0] - [(0,8,ESeq), (8,9,ESeq), (9,4,ESeq), (4,5,ESeq), (5,19,ESeq), (19,18,ESeq), (18,1,ESeq)] + [(0,8,ESeq Nothing), (8,9,ESeq Nothing), (9,4,ESeq Nothing), (4,5,ESeq Nothing), (5,19,ESeq Nothing), (19,18,ESeq Nothing), (18,1,ESeq Nothing)] (A.Alt m1 False $ spec8 $ spec9 $ A.Only mU guard45) ,testGraph "testAlt 4" [(0, m1), (1, sub m1 1), (4,m4), (5,m5), (6, m6), (7, m7), (8,m8), (18, sub m8 100)] [0] - [(0,8,ESeq), (8,4,ESeq), (8,6,ESeq), (4,5,ESeq), (6,7,ESeq), (5,18,ESeq), (7,18,ESeq), (18, 1, ESeq)] + [(0,8,ESeq Nothing), (8,4,ESeq Nothing), (8,6,ESeq Nothing), (4,5,ESeq Nothing), (6,7,ESeq Nothing), (5,18,ESeq Nothing), (7,18,ESeq Nothing), (18, 1, ESeq Nothing)] (A.Alt m1 False $ A.Several mU $ [A.Only mU guard45, spec8 $ A.Only mU guard67]) ,testGraph "testAlt 5" [(0, m1), (1, sub m1 1), (4,m4), (5,m5), (6, m6), (7, m7), (8,m8), (18, sub m8 100), (9,m9), (19, sub m9 100)] [0] - [(0,9,ESeq), (9,8,ESeq),(8,4,ESeq), (8,6,ESeq), (4,5,ESeq), (6,7,ESeq), (5,18,ESeq), (7,18,ESeq), (18, 19, ESeq), (19,1,ESeq)] + [(0,9,ESeq Nothing), (9,8,ESeq Nothing),(8,4,ESeq Nothing), (8,6,ESeq Nothing), (4,5,ESeq Nothing), (6,7,ESeq Nothing), (5,18,ESeq Nothing), (7,18,ESeq Nothing), (18, 19, ESeq Nothing), (19,1,ESeq Nothing)] (A.Alt m1 False $ A.Several mU $ [spec9 $ A.Only mU guard45, spec8 $ A.Only mU guard67]) -- TODO test replicated ALTs diff --git a/flow/FlowUtils.hs b/flow/FlowUtils.hs index 5a7510f..aa4f520 100644 --- a/flow/FlowUtils.hs +++ b/flow/FlowUtils.hs @@ -38,7 +38,7 @@ import Utils -- Multiple Seq links means choice. -- 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 -data EdgeLabel = ESeq | EStartPar Int | EEndPar Int deriving (Show, Eq, Ord) +data EdgeLabel = ESeq (Maybe Bool) | EStartPar Int | EEndPar Int deriving (Show, Eq, Ord) -- | 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 @@ -258,7 +258,8 @@ 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 s e) nodes +joinPairs m nodes = do sequence_ $ mapPairs (\(_,s) (e,_) -> addEdge (ESeq + Nothing) s e) nodes return (fst (head nodes), snd (last nodes)) decomp22 :: (Monad m, Data a, Typeable a0, Typeable a1) => (a0 -> a1 -> a) -> (a1 -> m a1) -> (a -> m a)