Fixed the flow algorithms to discard nodes that should not feature (e.g. nodes with no onward path in backward data flow)
This commit is contained in:
parent
f4fb8823ae
commit
73d1bdc711
|
@ -231,7 +231,7 @@ checkInitVar m graph startNode
|
||||||
-- Now we check that for every variable read in each node, it has already been written to by then
|
-- Now we check that for every variable read in each node, it has already been written to by then
|
||||||
mapM_ (checkInitVar' vwb) (map readNode labelledConnectedNodes)
|
mapM_ (checkInitVar' vwb) (map readNode labelledConnectedNodes)
|
||||||
where
|
where
|
||||||
connectedNodes = udfs [startNode] graph
|
connectedNodes = dfs [startNode] graph
|
||||||
|
|
||||||
-- Gets all variables read-from in a particular node, and the node identifier
|
-- Gets all variables read-from in a particular node, and the node identifier
|
||||||
readNode :: (Node, FNode m UsageLabel) -> (Node, ExSet Var)
|
readNode :: (Node, FNode m UsageLabel) -> (Node, ExSet Var)
|
||||||
|
|
|
@ -133,7 +133,7 @@ checkPar getRep f g = mapM f =<< allParItems
|
||||||
findReachDef :: forall m. Monad m => FlowGraph m UsageLabel -> Node -> Either String (Map.Map Node (Map.Map Var (Set.Set (Maybe
|
findReachDef :: forall m. Monad m => FlowGraph m UsageLabel -> Node -> Either String (Map.Map Node (Map.Map Var (Set.Set (Maybe
|
||||||
A.Expression))))
|
A.Expression))))
|
||||||
findReachDef graph startNode
|
findReachDef graph startNode
|
||||||
= do r <- flowAlgorithm graphFuncs (udfs [startNode] graph) (startNode, Map.empty)
|
= do r <- flowAlgorithm graphFuncs (dfs [startNode] graph) (startNode, Map.empty)
|
||||||
-- These lines remove the maps where the variable is not read in that particular node:
|
-- These lines remove the maps where the variable is not read in that particular node:
|
||||||
return $ Map.filter (not . Map.null) r
|
return $ Map.filter (not . Map.null) r
|
||||||
where
|
where
|
||||||
|
@ -184,7 +184,7 @@ findReachDef graph startNode
|
||||||
findConstraints :: Monad m => FlowGraph m UsageLabel -> Node -> Either String
|
findConstraints :: Monad m => FlowGraph m UsageLabel -> Node -> Either String
|
||||||
(Map.Map Node [A.Expression])
|
(Map.Map Node [A.Expression])
|
||||||
findConstraints graph startNode
|
findConstraints graph startNode
|
||||||
= flowAlgorithm graphFuncs (udfs [startNode] graph) (startNode, [])
|
= flowAlgorithm graphFuncs (dfs [startNode] graph) (startNode, [])
|
||||||
>>* Map.filter (not . null)
|
>>* Map.filter (not . null)
|
||||||
where
|
where
|
||||||
graphFuncs :: GraphFuncs Node EdgeLabel [A.Expression]
|
graphFuncs :: GraphFuncs Node EdgeLabel [A.Expression]
|
||||||
|
|
|
@ -55,8 +55,11 @@ data GraphFuncs n e result = GF {
|
||||||
--
|
--
|
||||||
-- The implication of the above is that you should /not/ pass as the second
|
-- The implication of the above is that you should /not/ pass as the second
|
||||||
-- parameter all the nodes in the graph (unless you /know/ that it is fully
|
-- parameter all the nodes in the graph (unless you /know/ that it is fully
|
||||||
-- connected). Instead you should pass the connected nodes, using @(udfs [startNode]
|
-- connected). Instead you should pass the connected nodes. If you are doing
|
||||||
-- graph)@.
|
-- forward data flow (using @nodesToProcess = lpre graph@), you can find the connected
|
||||||
|
-- nodes using @(dfs [initNode] graph)@. If you are doing backward data flow
|
||||||
|
-- (using @nodesToProcess = lsuc graph@), you can find the connected nodes using
|
||||||
|
-- @(rdfs [initNode] graph)@.
|
||||||
--
|
--
|
||||||
-- The general idea of iterative data-flow is that all nodes start out with
|
-- The general idea of iterative data-flow is that all nodes start out with
|
||||||
-- a default "guessed" value. Then each node is processed in turn by using
|
-- a default "guessed" value. Then each node is processed in turn by using
|
||||||
|
@ -78,14 +81,23 @@ flowAlgorithm :: forall n e result. (Ord n, Show n, Eq result) =>
|
||||||
-- nodes to results
|
-- nodes to results
|
||||||
flowAlgorithm funcs nodes (startNode, startVal)
|
flowAlgorithm funcs nodes (startNode, startVal)
|
||||||
= iterate
|
= iterate
|
||||||
(Set.fromList nonStartNodes)
|
nonStartNodesSet
|
||||||
(Map.fromList $ (startNode, startVal):(zip nonStartNodes (repeat (defVal funcs))))
|
(Map.fromList $ (startNode, startVal):(zip nonStartNodes (repeat (defVal funcs))))
|
||||||
where
|
where
|
||||||
-- The nodes list, with the start node removed:
|
-- The nodes list, with the start node removed:
|
||||||
nonStartNodes :: [n]
|
nonStartNodes :: [n]
|
||||||
nonStartNodes = (filter ((/=) startNode) nodes)
|
nonStartNodes = (filter ((/=) startNode) nodes)
|
||||||
|
|
||||||
-- | Folds left, but with either types involved. Gives an error if there
|
nonStartNodesSet :: Set.Set n
|
||||||
|
nonStartNodesSet = Set.fromList nonStartNodes
|
||||||
|
|
||||||
|
allNodesSet :: Set.Set n
|
||||||
|
allNodesSet = Set.singleton startNode `Set.union` nonStartNodesSet
|
||||||
|
|
||||||
|
filtNodes :: [(n,e)] -> [(n,e)]
|
||||||
|
filtNodes = filter ((`Set.member` allNodesSet) . fst)
|
||||||
|
|
||||||
|
-- | Folds left, but with Either types involved. Gives an error if there
|
||||||
-- are no nodes in the given list at the start (i.e. when its second parameter
|
-- are no nodes in the given list at the start (i.e. when its second parameter
|
||||||
-- is Left). Otherwise feeds the aggregate result back round on each
|
-- is Left). Otherwise feeds the aggregate result back round on each
|
||||||
-- iteration of the list, but stops at the first error while folding (so
|
-- iteration of the list, but stops at the first error while folding (so
|
||||||
|
@ -137,13 +149,14 @@ flowAlgorithm funcs nodes (startNode, startVal)
|
||||||
total <- foldWithEither (iterateNode vals) (Left $
|
total <- foldWithEither (iterateNode vals) (Left $
|
||||||
"Nodes still to process: " ++ show workList
|
"Nodes still to process: " ++ show workList
|
||||||
++ " " ++ userErrLabel funcs node)
|
++ " " ++ userErrLabel funcs node)
|
||||||
(nodesToProcess funcs node)
|
(filtNodes $ nodesToProcess funcs node)
|
||||||
nodeVal <- Map.lookup node vals
|
nodeVal <- Map.lookup node vals
|
||||||
if total /= nodeVal
|
if total /= nodeVal
|
||||||
-- If the value has changed, that will cascade to affect all
|
-- If the value has changed, that will cascade to affect all
|
||||||
-- its dependents, so add all
|
-- its dependents, so add all
|
||||||
-- of them back to the work list:
|
-- of them back to the work list:
|
||||||
then iterate (workList' `Set.union` (Set.fromList $ map fst $ nodesToReAdd funcs node)) (Map.insert node total vals)
|
then iterate (workList' `Set.union` (Set.fromList $
|
||||||
|
map fst $ filtNodes $ nodesToReAdd funcs node)) (Map.insert node total vals)
|
||||||
-- If the value hasn't changed, forget it and go on to the
|
-- If the value hasn't changed, forget it and go on to the
|
||||||
-- next one:
|
-- next one:
|
||||||
else iterate workList' vals
|
else iterate workList' vals
|
||||||
|
|
|
@ -77,7 +77,7 @@ effectDecision _ Copy _ = return
|
||||||
calculateUsedAgainAfter :: Monad m => FlowGraph m UsageLabel -> Node -> Either String (Map.Map Node
|
calculateUsedAgainAfter :: Monad m => FlowGraph m UsageLabel -> Node -> Either String (Map.Map Node
|
||||||
(Set.Set Var))
|
(Set.Set Var))
|
||||||
calculateUsedAgainAfter g startNode
|
calculateUsedAgainAfter g startNode
|
||||||
= flowAlgorithm funcs (udfs [startNode] g) (startNode, Set.empty)
|
= flowAlgorithm funcs (rdfs [startNode] g) (startNode, Set.empty)
|
||||||
where
|
where
|
||||||
funcs :: GraphFuncs Node EdgeLabel (Set.Set Var)
|
funcs :: GraphFuncs Node EdgeLabel (Set.Set Var)
|
||||||
funcs = GF
|
funcs = GF
|
||||||
|
|
Loading…
Reference in New Issue
Block a user