From 73d1bdc71121c36d1985ca4916b9be43e2552799 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 11 Sep 2008 21:46:03 +0000 Subject: [PATCH] Fixed the flow algorithms to discard nodes that should not feature (e.g. nodes with no onward path in backward data flow) --- checks/Check.hs | 2 +- checks/UsageCheckAlgorithms.hs | 4 ++-- flow/FlowAlgorithms.hs | 25 +++++++++++++++++++------ transformations/ImplicitMobility.hs | 2 +- 4 files changed, 23 insertions(+), 10 deletions(-) diff --git a/checks/Check.hs b/checks/Check.hs index 256a2ab..10a9332 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -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 mapM_ (checkInitVar' vwb) (map readNode labelledConnectedNodes) where - connectedNodes = udfs [startNode] graph + connectedNodes = dfs [startNode] graph -- Gets all variables read-from in a particular node, and the node identifier readNode :: (Node, FNode m UsageLabel) -> (Node, ExSet Var) diff --git a/checks/UsageCheckAlgorithms.hs b/checks/UsageCheckAlgorithms.hs index 4cd0e87..4633977 100644 --- a/checks/UsageCheckAlgorithms.hs +++ b/checks/UsageCheckAlgorithms.hs @@ -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 A.Expression)))) 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: return $ Map.filter (not . Map.null) r where @@ -184,7 +184,7 @@ findReachDef graph startNode findConstraints :: Monad m => FlowGraph m UsageLabel -> Node -> Either String (Map.Map Node [A.Expression]) findConstraints graph startNode - = flowAlgorithm graphFuncs (udfs [startNode] graph) (startNode, []) + = flowAlgorithm graphFuncs (dfs [startNode] graph) (startNode, []) >>* Map.filter (not . null) where graphFuncs :: GraphFuncs Node EdgeLabel [A.Expression] diff --git a/flow/FlowAlgorithms.hs b/flow/FlowAlgorithms.hs index c9e25fd..022bd2a 100644 --- a/flow/FlowAlgorithms.hs +++ b/flow/FlowAlgorithms.hs @@ -55,8 +55,11 @@ data GraphFuncs n e result = GF { -- -- 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 --- connected). Instead you should pass the connected nodes, using @(udfs [startNode] --- graph)@. +-- connected). Instead you should pass the connected nodes. If you are doing +-- 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 -- 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 flowAlgorithm funcs nodes (startNode, startVal) = iterate - (Set.fromList nonStartNodes) + nonStartNodesSet (Map.fromList $ (startNode, startVal):(zip nonStartNodes (repeat (defVal funcs)))) where -- The nodes list, with the start node removed: nonStartNodes :: [n] 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 -- is Left). Otherwise feeds the aggregate result back round on each -- 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 $ "Nodes still to process: " ++ show workList ++ " " ++ userErrLabel funcs node) - (nodesToProcess funcs node) + (filtNodes $ nodesToProcess funcs node) nodeVal <- Map.lookup node vals if total /= nodeVal -- If the value has changed, that will cascade to affect all -- its dependents, so add all -- 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 -- next one: else iterate workList' vals diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs index a023f0c..9ce58f4 100644 --- a/transformations/ImplicitMobility.hs +++ b/transformations/ImplicitMobility.hs @@ -77,7 +77,7 @@ effectDecision _ Copy _ = return calculateUsedAgainAfter :: Monad m => FlowGraph m UsageLabel -> Node -> Either String (Map.Map Node (Set.Set Var)) calculateUsedAgainAfter g startNode - = flowAlgorithm funcs (udfs [startNode] g) (startNode, Set.empty) + = flowAlgorithm funcs (rdfs [startNode] g) (startNode, Set.empty) where funcs :: GraphFuncs Node EdgeLabel (Set.Set Var) funcs = GF