suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added information in the flow graph edges as to when a condition becomes non-usable (e.g. when the branches of an IF merge again)

Browse Source
This commit is contained in:
Neil Brown 2009-02-09 16:57:13 +00:00
parent 904b913ebd
commit c315352647
4 changed files with 95 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
checks/UsageCheckAlgorithms.hs
View File

@ -203,8 +203,9 @@ findConstraints graph startNode
Just u -> Just u ->
let valFilt = filter (\e -> null $ intersect (listify (const let valFilt = filter (\e -> null $ intersect (listify (const
True) e) [v | Var v <- Map.keys $ writtenVars $ nodeVars u]) $ True) e) [v | Var v <- Map.keys $ writtenVars $ nodeVars u]) $
nub $ nodeVal ++ if e == ESeq (Just True) then maybeToList (nodeCond u) nub $ nodeVal ++ (case e of
else [] in ESeq (Just (_, Just True)) -> maybeToList (nodeCond u)
_ -> []) in
nub $ valFilt ++ fromMaybe [] curAgg nub $ valFilt ++ fromMaybe [] curAgg
Nothing -> [] Nothing -> []

74
flow/FlowGraph.hs
View File

@ -253,52 +253,59 @@ buildStructuredCase (nStart, nEnd) (A.Spec _ spec str) route
n' --> nEnd n' --> nEnd
withDeclSpec spec $ buildStructuredCase (n, n') str (route33 route A.Spec) withDeclSpec spec $ buildStructuredCase (n, n') str (route33 route A.Spec)
-- While building an IF, we keep a stack of identifiers used for the various conditionals.
-- At the end of the block you must make sure there are edges that terminate all
-- these identifiers, after the joining together of all the branches
buildStructuredIf :: forall mLabel mAlter label structType. (Monad mLabel, Monad mAlter) => (Node, Node) -> A.Structured A.Choice -> ASTModifier mAlter (A.Structured A.Choice) structType -> buildStructuredIf :: forall mLabel mAlter label structType. (Monad mLabel, Monad mAlter) => (Node, Node) -> A.Structured A.Choice -> ASTModifier mAlter (A.Structured A.Choice) structType ->
GraphMaker mLabel mAlter label structType Node StateT [Integer] (GraphMaker mLabel mAlter label structType) Node
buildStructuredIf (prev, end) (A.Several _ ss) route buildStructuredIf (prev, end) (A.Several _ ss) route
= foldM foldIf prev (zip [0..] ss) = foldM foldIf prev (zip [0..] ss)
where where
foldIf :: Node -> (Int,A.Structured A.Choice) -> GraphMaker mLabel mAlter label structType Node foldIf :: Node -> (Int,A.Structured A.Choice) ->
StateT [Integer] (GraphMaker mLabel mAlter label structType) Node
foldIf prev (ind, s) = buildStructuredIf (prev, end) s $ route22 route A.Several @-> (routeList ind) foldIf prev (ind, s) = buildStructuredIf (prev, end) s $ route22 route A.Several @-> (routeList ind)
buildStructuredIf (prev, end) (A.ProcThen _ p str) route buildStructuredIf (prev, end) (A.ProcThen _ p str) route
= do (ps, pe) <- buildProcess p (route23 route A.ProcThen) = do (ps, pe) <- lift $ buildProcess p (route23 route A.ProcThen)
prev --> ps lift $ prev --> ps
buildStructuredIf (pe, end) str (route33 route A.ProcThen) buildStructuredIf (pe, end) str (route33 route A.ProcThen)
buildStructuredIf (prev, end) (A.Only _ c) route buildStructuredIf (prev, end) (A.Only _ c) route
= buildOnlyChoice (prev, end) (route22 route A.Only) c = do id <- lift getNextParEdgeId
modify (id:)
lift $ buildOnlyChoice (prev, end) (route22 route A.Only) c id
buildStructuredIf (prev, end) (A.Spec _ spec@(A.Specification _ nm (A.Rep _ rep)) str) route buildStructuredIf (prev, end) (A.Spec _ spec@(A.Specification _ nm (A.Rep _ rep)) str) route
= let alter = AlterReplicator $ route22 (route33 (route23 route A.Spec) A.Specification) A.Rep in = let alter = AlterReplicator $ route22 (route33 (route23 route A.Spec) A.Specification) A.Rep in
do repNode <- addNode' (findMeta rep) labelReplicator (nm, rep) alter do repNode <- lift $ addNode' (findMeta rep) labelReplicator (nm, rep) alter
lastNode <- withDeclSpec spec $ buildStructuredIf (repNode, end) str (route33 route A.Spec) lastNode <- liftWrapStateT (withDeclSpec spec) $ buildStructuredIf (repNode, end) str (route33 route A.Spec)
prev --> repNode lift $ prev --> repNode
lastNode --> repNode lift $ lastNode --> repNode
return repNode return repNode
buildStructuredIf (prev, end) (A.Spec _ spec str) route buildStructuredIf (prev, end) (A.Spec _ spec str) route
-- Specs are tricky in IFs, because they can scope out either -- Specs are tricky in IFs, because they can scope out either
-- at the end of a choice-block, or when moving on to the next -- at the end of a choice-block, or when moving on to the next
-- choice. But these nodes are not the same because they have -- choice. But these nodes are not the same because they have
-- different connections leading out of them -- different connections leading out of them
= do nIn <- addNode' (findMeta spec) labelScopeIn spec (AlterSpec $ route23 route A.Spec) = do nIn <- lift $ addNode' (findMeta spec) labelScopeIn spec (AlterSpec $ route23 route A.Spec)
nOutBlock <- addNode' (findMeta spec) labelScopeOut spec (AlterSpec $ route23 route A.Spec) nOutBlock <- lift $ addNode' (findMeta spec) labelScopeOut spec (AlterSpec $ route23 route A.Spec)
nOutNext <- addNode' (findMeta spec) labelScopeOut spec (AlterSpec $ route23 route A.Spec) nOutNext <- lift $ addNode' (findMeta spec) labelScopeOut spec (AlterSpec $ route23 route A.Spec)
last <- withDeclSpec spec $ buildStructuredIf (nIn, nOutBlock) str (route33 route A.Spec) last <- liftWrapStateT (withDeclSpec spec) $ buildStructuredIf (nIn, nOutBlock) str (route33 route A.Spec)
lift $ do
prev --> nIn
when (last /= prev) $ -- Only add the edge if there was a block it's connected to!
nOutBlock --> end
last --> nOutNext
return nOutNext
prev --> nIn buildOnlyChoice :: (Monad mLabel, Monad mAlter) => (Node, Node) -> ASTModifier mAlter A.Choice structType -> A.Choice ->
when (last /= prev) $ -- Only add the edge if there was a block it's connected to! Integer -> GraphMaker mLabel mAlter label structType Node
nOutBlock --> end buildOnlyChoice (cPrev, cEnd) route (A.Choice m exp p) edgeId
last --> nOutNext
return nOutNext
buildOnlyChoice :: (Monad mLabel, Monad mAlter) => (Node, Node) -> ASTModifier mAlter A.Choice structType -> A.Choice -> GraphMaker mLabel mAlter label structType Node
buildOnlyChoice (cPrev, cEnd) route (A.Choice m exp p)
= do nexp <- addNode' (findMeta exp) labelConditionalExpression exp = do nexp <- addNode' (findMeta exp) labelConditionalExpression exp
$ AlterExpression $ route23 route A.Choice $ AlterExpression $ route23 route A.Choice
nexpf <- addDummyNode m route nexpf <- addDummyNode m route
(nbodys, nbodye) <- buildProcess p $ route33 route A.Choice (nbodys, nbodye) <- buildProcess p $ route33 route A.Choice
cPrev --> nexp cPrev --> nexp
addEdge (ESeq $ Just True) nexp nbodys addEdge (ESeq $ Just (edgeId, Just True)) nexp nbodys
addEdge (ESeq $ Just False) nexp nexpf addEdge (ESeq $ Just (edgeId, Just False)) nexp nexpf
nbodye --> cEnd nbodye --> cEnd
return nexpf return nexpf
@ -362,9 +369,12 @@ buildProcess (A.While m e p) route
$ route23 route A.While) $ route23 route A.While)
nAfter <- addDummyNode m route nAfter <- addDummyNode m route
(start, end) <- buildProcess p (route33 route A.While) (start, end) <- buildProcess p (route33 route A.While)
addEdge (ESeq $ Just True) n start edgeId <- getNextParEdgeId
addEdge (ESeq $ Just False) n nAfter addEdge (ESeq $ Just (edgeId, Just True)) n start
end --> n addEdge (ESeq $ Just (edgeId, Just False)) n nAfter
addEdge (ESeq $ Just (edgeId, Nothing)) end n
-- We are still taking the condition to be true after the while loop --
-- and it will remain so until the variables are later modified
return (n, nAfter) return (n, nAfter)
buildProcess (A.Case m e s) route buildProcess (A.Case m e s) route
= do nStart <- addNodeExpression (findMeta e) e (route23 route A.Case) = do nStart <- addNodeExpression (findMeta e) e (route23 route A.Case)
@ -373,9 +383,15 @@ buildProcess (A.Case m e s) route
return (nStart, nEnd) return (nStart, nEnd)
buildProcess (A.If m s) route buildProcess (A.If m s) route
= do nStart <- addDummyNode m route = do nStart <- addDummyNode m route
nEnd <- addDummyNode m route nFirstEnd <- addDummyNode m route
buildStructuredIf (nStart, nEnd) s (route22 route A.If) allEdgeIds <- flip execStateT [] $ buildStructuredIf (nStart, nFirstEnd) s (route22 route A.If)
return (nStart, nEnd) nLastEnd <- foldM addEndEdge nFirstEnd allEdgeIds
return (nStart, nLastEnd)
where
--addEndEdge :: Node -> Integer -> GraphMaker mLabel mAlter label structType Node
addEndEdge n id = do n' <- addDummyNode m route
addEdge (ESeq (Just (id, Nothing))) n n'
return n'
buildProcess (A.Alt m _ s) route buildProcess (A.Alt m _ s) route
= do nStart <- addDummyNode m route = do nStart <- addDummyNode m route
nEnd <- addDummyNode m route nEnd <- addDummyNode m route

65
flow/FlowGraphTest.hs
View File

@ -277,22 +277,23 @@ testPar = TestLabel "testPar" $ TestList
testWhile :: Test testWhile :: Test
testWhile = TestLabel "testWhile" $ TestList testWhile = TestLabel "testWhile" $ TestList
[ [
testGraph "testWhile 0" [(0,m0), (1,m1), (2, m2)] [0] [(0,1,ESeq $ Just True), (1,0,ESeq Nothing), testGraph "testWhile 0" [(0,m0), (1,m1), (2, m2)] [0] [(0,1,ESeq $ Just (0,
(0,2, ESeq $ Just False)] (A.While m2 (A.True m0) sm1) Just True)), (1,0,ESeq $ Just (0, Nothing)), (0,2, ESeq $ Just (0, Just False))]
(A.While m2 (A.True m0) sm1)
,testGraph "testWhile 1" [(2,m2), (3, m3), (5, m5), (8, m8)] [2] ,testGraph "testWhile 1" [(2,m2), (3, m3), (5, m5), (8, m8)] [2]
[(2,3,ESeq $ Just True), (3,2,ESeq Nothing), (8,5,ESeq Nothing), (2,8, ESeq [(2,3,ESeq $ Just (0, Just True)), (3,2,ESeq $ Just (0, Nothing)), (8,5,ESeq Nothing), (2,8, ESeq
$ Just False)] $ Just (0, Just False))]
(A.Seq m0 $ A.Several m1 [A.Only m9 $ A.While m8 (A.True m2) sm3,A.Only m4 sm5]) (A.Seq m0 $ A.Several m1 [A.Only m9 $ A.While m8 (A.True m2) sm3,A.Only m4 sm5])
,testGraph "testWhile 2" [(2,m2), (3, m3), (5, m5), (7, m7), (8, m8)] [7] ,testGraph "testWhile 2" [(2,m2), (3, m3), (5, m5), (7, m7), (8, m8)] [7]
[(7,2,ESeq Nothing), (2,3,ESeq $ Just True), (3,2,ESeq Nothing), (2, 8, ESeq [(7,2,ESeq Nothing), (2,3,ESeq $ Just (0, Just True)), (3,2,ESeq $ Just (0, Nothing)),
$ Just False), (8,5,ESeq Nothing)] (2, 8, ESeq $ Just (0, Just False)), (8,5,ESeq Nothing)]
(A.Seq m0 $ A.Several m1 [A.Only m6 sm7,A.Only m9 $ A.While m8 (A.True m2) sm3,A.Only m4 sm5]) (A.Seq m0 $ A.Several m1 [A.Only m6 sm7,A.Only m9 $ A.While m8 (A.True m2) sm3,A.Only m4 sm5])
,testGraph "testWhile 3" [(2,m2), (3, m3), (5, m5), (7, m7), (9, m9), (8, m8)] [7] ,testGraph "testWhile 3" [(2,m2), (3, m3), (5, m5), (7, m7), (9, m9), (8, m8)] [7]
[(7,2,ESeq Nothing), (2,3,ESeq $ Just True), (3,9,ESeq Nothing), (9,2,ESeq Nothing), (2, [(7,2,ESeq Nothing), (2,3,ESeq $ Just (0, Just True)), (3,9,ESeq Nothing), (9,2,ESeq $
8, ESeq $ Just False), (8,5,ESeq Nothing)] Just (0, Nothing)), (2, 8, ESeq $ Just (0, Just False)), (8,5,ESeq Nothing)]
(A.Seq m0 $ A.Several m1 [A.Only m6 sm7,A.Only mU $ A.While m8 (A.True m2) $ A.Seq mU $ A.Several mU [A.Only mU sm3,A.Only mU sm9],A.Only m4 sm5]) (A.Seq m0 $ A.Several m1 [A.Only m6 sm7,A.Only mU $ A.While m8 (A.True m2) $ A.Seq mU $ A.Several mU [A.Only mU sm3,A.Only mU sm9],A.Only m4 sm5])
] ]
@ -320,21 +321,26 @@ testIf = TestLabel "testIf" $ TestList
-- Remember that the last branch of an IF doesn't link to the end of the IF, because -- 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. -- occam stops if no option is found.
testGraph "testIf 0" [(0,m0), (1,sub m0 1), (2,m2), (4, sub m2 1), (3,m3)] [0] testGraph "testIf 0" [(0,m0), (1,sub m0 1), (2,m2), (4, sub m2 1), (3,m3), (5,
[(0,2,nt),(2,3,tr), (2,4, fal), (3,1,nt)] sub m0 2)] [0]
[(0,2,nt),(2,3,tr 0), (2,4, fal 0), (3,1,nt), (1, 5, inv 0)]
(A.If m0 $ ifs mU [(A.True m2, sm3)]) (A.If m0 $ ifs mU [(A.True m2, sm3)])
,testGraph "testIf 1" [(0,m0), (1,sub m0 1), (2,m2), (12, m2 `sub` 1), (3,m3), ,testGraph "testIf 1" [(0,m0), (1,sub m0 1), (2,m2), (12, m2 `sub` 1), (3,m3),
(4,m4), (14, m4 `sub` 1), (5, m5)] [0] (4,m4), (14, m4 `sub` 1), (5, m5), (11, sub m0 2), (21,
[(0,2,nt),(2,3,tr),(3,1,nt),(2,12, fal), (12, 4, nt), sub m0 3)] [0]
(4,5,tr),(5,1,nt),(4,14,fal)] [(0,2,nt),(2,3,tr 0),(3,1,nt),(2,12, fal 0), (12, 4, nt),
(4,5,tr 1),(5,1,nt),(4,14,fal 1), (1, 11, inv 1), (11,
21, inv 0)]
(A.If m0 $ ifs mU [(A.True m2, sm3), (A.True m4, sm5)]) (A.If m0 $ ifs mU [(A.True m2, sm3), (A.True m4, sm5)])
,testGraph "testIf 2" [(0,m0), (1,sub m0 1), (2,m2), (12, m2 `sub` 1), (3,m3), ,testGraph "testIf 2" [(0,m0), (1,sub m0 1), (2,m2), (12, m2 `sub` 1), (3,m3),
(4,m4), (14, m4 `sub` 1), (5, m5), (6, m6), (16, m6 `sub` 1),(7, m7)] [0] (4,m4), (14, m4 `sub` 1), (5, m5), (6, m6), (16, m6 `sub` 1),(7, m7),
[(0,2,nt),(2,3,tr),(3,1,nt),(2,12,fal),(12,4,nt), (11, sub m0 2), (21, sub m0 3), (31, sub m0 4)] [0]
(4,5,tr),(5,1,nt),(4,14,fal), [(0,2,nt),(2,3,tr 0),(3,1,nt),(2,12,fal 0),(12,4,nt),
(14,6,nt),(6,7,tr),(7,1,nt),(6,16,fal)] (4,5,tr 1),(5,1,nt),(4,14,fal 1),
(14,6,nt),(6,7,tr 2),(7,1,nt),(6,16,fal 2),
(1,11,inv 2), (11, 21, inv 1), (21, 31, inv 0)]
(A.If m0 $ ifs mU [(A.True m2, sm3), (A.True m4, sm5), (A.True m6, sm7)]) (A.If m0 $ ifs mU [(A.True m2, sm3), (A.True m4, sm5), (A.True m6, sm7)])
{- {-
@ -345,26 +351,31 @@ testIf = TestLabel "testIf" $ TestList
(A.If m0 $ A.Spec mU (someSpec m4) $ ifs mU [(A.True m2, sm3)]) (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), (12, m2 `sub` 1), (3,m3), (5, m5)] [0] ,testGraph "testIf 10" [(0,m0), (1,sub m0 1), (2,m2), (12, m2 `sub` 1), (3,m3), (5, m5),
[(0,5,nt), (5,2,nt), (2,3,tr), (3,1,nt), (2,12, fal), (12, 5, nt)] (11, sub m0 2)] [0]
[(0,5,nt), (5,2,nt), (2,3,tr 0), (3,1,nt), (2,12, fal 0), (12, 5, nt), (1, 11, inv 0)]
(A.If m0 $ rep m5 $ ifs mU [(A.True m2, sm3)]) (A.If m0 $ rep m5 $ ifs mU [(A.True m2, sm3)])
,testGraph "testIf 11" [(0,m0), (1,sub m0 1), (2,m2), (12, m2 `sub` 1), (3,m3), (5, m5), (6, m6), (16, ,testGraph "testIf 11" [(0,m0), (1,sub m0 1), (2,m2), (12, m2 `sub` 1), (3,m3), (5, m5), (6, m6), (16,
m6 `sub` 1), (7, m7)] [0] m6 `sub` 1), (7, m7), (11, sub m0 2), (21, sub m0 3)] [0]
[(0,5,nt), (5,2,nt), (2,3,tr), (3,1,nt), (2,12,fal), (12, 6, nt), (6,7,tr), (7,1,nt), (6,16,fal),(16, 5, nt)] [(0,5,nt), (5,2,nt), (2,3,tr 0), (3,1,nt), (2,12,fal 0), (12, 6, nt), (6,7,tr
1), (7,1,nt), (6,16,fal 1),(16, 5, nt), (1, 11, inv 1), (11, 21, inv 0)]
(A.If m0 $ rep m5 $ ifs mU [(A.True m2, sm3), (A.True m6, sm7)]) (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), ,testGraph "testIf 12" [(0,m0), (1,sub m0 1), (2,m2), (3,m3), (5, m5), (6, m6), (7, m7), (8, m8), (9, m9),
(12, m2 `sub` 1), (16, m6 `sub` 1), (18, m8 `sub` 1)] [0] (12, m2 `sub` 1), (16, m6 `sub` 1), (18, m8 `sub` 1), (11, sub m0 2), (21,
[(0,5,nt), (5,2,nt), (2,3,tr), (3,1,nt), (2,12,fal), (12, 6, nt), sub m0 3), (31, sub m0 4)] [0]
(6,7,tr), (7,1,nt), (6,16,fal), (16, 5, nt), (5,8,nt), [(0,5,nt), (5,2,nt), (2,3,tr 0), (3,1,nt), (2,12,fal 0), (12, 6, nt),
(8,9,tr), (9,1,nt),(8,18,fal)] (6,7,tr 1), (7,1,nt), (6,16,fal 1), (16, 5, nt), (5,8,nt),
(8,9,tr 2), (9,1,nt),(8,18,fal 2), (1,11, inv 2), (11, 21, inv 1), (21, 31,
inv 0)]
(A.If m0 $ A.Several mU [rep m5 $ ifs mU [(A.True m2, sm3), (A.True m6, sm7)] (A.If m0 $ A.Several mU [rep m5 $ ifs mU [(A.True m2, sm3), (A.True m6, sm7)]
, ifs mU [(A.True m8, sm9)]]) , ifs mU [(A.True m8, sm9)]])
] ]
where where
fal = ESeq $ Just False fal n = ESeq $ Just (n, Just False)
tr = ESeq $ Just True tr n = ESeq $ Just (n, Just True)
inv n = ESeq $ Just (n, Nothing)
nt = ESeq Nothing nt = ESeq Nothing
ifs :: Meta -> [(A.Expression, A.Process)] -> A.Structured A.Choice ifs :: Meta -> [(A.Expression, A.Process)] -> A.Structured A.Choice

11
flow/FlowUtils.hs
View File

@ -39,7 +39,14 @@ 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 Integer | EEndPar Integer deriving (Show, Eq, Ord) --
-- If a Seq link has a Just label, it indicates whether the condition at the source
-- node evaluated to True or False. Each such link has an associated Integer.
-- When you see that integer again in a Seq link with a Nothing for the bool value,
-- that is the point at which you can no longer assume the condition holds. So
-- for example, going into an IF block will have an Just (N, Just True) label,
-- and the end of that block will have a Just (N, Nothing) label.
data EdgeLabel = ESeq (Maybe (Integer, 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
@ -99,7 +106,7 @@ data GraphMakerState mAlter a b = GraphMakerState
, nameStack :: [String] , nameStack :: [String]
} }
type GraphMaker mLabel mAlter a b c = ErrorT String (ReaderT (GraphLabelFuncs mLabel a) (StateT (GraphMakerState mAlter a b) mLabel)) c type GraphMaker mLabel mAlter a b = ErrorT String (ReaderT (GraphLabelFuncs mLabel a) (StateT (GraphMakerState mAlter a b) mLabel))
-- | The GraphLabelFuncs type. These are a group of functions -- | The GraphLabelFuncs type. These are a group of functions
-- used to provide labels for different elements of AST. -- used to provide labels for different elements of AST.