From 3b43411d4ec332a70ea7fb159433bd232be76a7e Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Fri, 2 Nov 2007 23:47:20 +0000 Subject: [PATCH] Changed the type of findReachDef, implemented it, and wrote some basic tests for it (that pass) --- transformations/RainUsageCheck.hs | 59 ++++++++++++++++++++++++++- transformations/RainUsageCheckTest.hs | 36 +++++++++++++++- 2 files changed, 91 insertions(+), 4 deletions(-) diff --git a/transformations/RainUsageCheck.hs b/transformations/RainUsageCheck.hs index 3a11ba6..87fe535 100644 --- a/transformations/RainUsageCheck.hs +++ b/transformations/RainUsageCheck.hs @@ -322,6 +322,61 @@ checkInitVar graph startNode ++ " writtenMap: " ++ show writtenMap -- | Returns either an error, or map *from* the node with a read, *to* the node whose definitions might be available at that point -findReachDef :: FlowGraph (Maybe Decl, Vars) -> Node -> Either String (Map.Map Node (Set.Set Node)) -findReachDef graph startNode = Left "Unimplemented" +-- I considered having the return type be Map Var (Map Node x)) rather than Map (Var,Node) x, but the time for lookup +-- will be identical (log N + log V in the former case, log (V*N) in the latter), and having a pair seemed simpler. +findReachDef :: FlowGraph (Maybe Decl, Vars) -> Node -> Either String (Map.Map Node (Map.Map Var (Set.Set Node))) +findReachDef graph startNode + = do r <- flowAlgorithm graphFuncs (nodes graph) startNode + -- These lines remove the maps where the variable is not read in that particular node: + let r' = Map.mapWithKey (\n -> Map.filterWithKey (readInNode' n)) r + return $ Map.filter (not . Map.null) r' + where + graphFuncs :: GraphFuncs Node EdgeLabel (Map.Map Var (Set.Set Node)) + graphFuncs = GF + { + nodeFunc = processNode + ,prevNodes = lpre graph + ,nextNodes = lsuc graph + ,initVal = Map.empty + ,defVal = Map.empty + } + + readInNode' :: Node -> Var -> a -> Bool + readInNode' n v _ = readInNode v (lab graph n) + + readInNode :: Var -> Maybe (FNode (Maybe Decl, Vars)) -> Bool + readInNode v (Just (Node (_,(_,Vars read _ _ _)))) = Set.member v read + + writeNode :: FNode (Maybe Decl, Vars) -> Set.Set Var + writeNode (Node (_,(_,Vars _ _ written _))) = written + + -- | A confusiing function used by processNode. It takes a node and node label, and uses + -- these to form a multi-map modifier function that replaces all node-sources for variables + -- written to by the given with node with a singleton set containing the given node. + -- That is, nodeLabelToMapInsert N (Node (_,Vars _ written _ _)) is a function that replaces + -- the sets for each v (v in written) with a singleton set {N}. + nodeLabelToMapInsert :: Node -> FNode (Maybe Decl, Vars) -> Map.Map Var (Set.Set Node) -> Map.Map Var (Set.Set Node) + nodeLabelToMapInsert n = foldFuncs . (map (\v -> Map.insert v (Set.singleton n) )) . Set.toList . writeNode + + processNode :: (Node, EdgeLabel) -> Map.Map Var (Set.Set Node) -> Maybe (Map.Map Var (Set.Set Node)) -> Map.Map Var (Set.Set Node) + processNode (n,_) inputVal mm = mergeMultiMaps modifiedInput prevAgg + where + -- Note that the two uses of maybe here use id in different senses. + -- In prevAgg, id is used on the value inside the Maybe. + -- Whereas, in modifiedInput, id is the default value (because a function is + -- what comes out of maybe) + + prevAgg :: Map.Map Var (Set.Set Node) + prevAgg = maybe Map.empty id mm + + modifiedInput :: Map.Map Var (Set.Set Node) + modifiedInput = (maybe id (nodeLabelToMapInsert n) $ lab graph n) inputVal + + -- | Folds a list of modifier functions into a single function + foldFuncs :: [a -> a] -> a -> a + foldFuncs = foldl (.) id + + -- | Merges two "multi-maps" (maps to sets) using union + mergeMultiMaps :: (Ord k, Ord a) => Map.Map k (Set.Set a) -> Map.Map k (Set.Set a) -> Map.Map k (Set.Set a) + mergeMultiMaps = Map.unionWith (Set.union) diff --git a/transformations/RainUsageCheckTest.hs b/transformations/RainUsageCheckTest.hs index ab03956..28718cd 100644 --- a/transformations/RainUsageCheckTest.hs +++ b/transformations/RainUsageCheckTest.hs @@ -244,18 +244,50 @@ testInitVar = TestList testReachDef :: Test testReachDef = TestList [ - test 0 [(0,[],[])] [] [] + -- Nothing written/read, blank results: + test 0 [(0,[],[])] [] [] + -- Written but not read, no results: + ,test 1 [(0,[],[Plain "x"])] [] [] + -- Written then read, no branching + ,test 2 [(0,[],[Plain "x"]),(1,[Plain "x"],[])] [(0,1,ESeq)] [(1,[0])] + ,test 3 [(0,[],[Plain "x"]),(1,[],[]),(2,[Plain "x"],[])] [(0,1,ESeq),(1,2,ESeq)] [(2,[0])] + ,test 4 [(0,[],[Plain "x"]),(1,[],[Plain "x"]),(2,[Plain "x"],[])] [(0,1,ESeq),(1,2,ESeq)] [(2,[1])] + + -- Lattice, written in 0, read in 3: + ,test 100 [(0,[],[Plain "x"]),(1,[],[]),(2,[],[]),(3,[Plain "x"],[])] latEdges [(3,[0])] + -- Lattice, written in 0, read in 1,2 and 3: + ,test 101 [(0,[],[Plain "x"]),(1,[Plain "x"],[]),(2,[Plain "x"],[]),(3,[Plain "x"],[])] latEdges [(3,[0]),(1,[0]),(2,[0])] + -- Lattice, written 0, 1 and 2, read in 3: + ,test 102 [(0,[],[Plain "x"]),(1,[],[Plain "x"]),(2,[],[Plain "x"]),(3,[Plain "x"],[])] latEdges [(3,[1,2])] + -- Lattice written in 0 and 1, read in 2 and 3: + ,test 103 [(0,[],[Plain "x"]),(1,[],[Plain "x"]),(2,[Plain "x"],[]),(3,[Plain "x"],[])] latEdges [(3,[0,1]),(2,[0])] + + --Loops: + + -- Written before loop, read afterwards: + ,test 200 [(0,[],[Plain "x"]),(1,[],[]),(2,[],[]),(3,[],[]),(4,[Plain "x"],[])] loopEdges [(4,[0])] + -- Written before loop, read during: + ,test 201 [(0,[],[Plain "x"]),(1,[],[]),(2,[Plain "x"],[]),(3,[],[]),(4,[],[])] loopEdges [(2,[0])] + -- Written before loop, written then read during: + ,test 202 [(0,[],[Plain "x"]),(1,[],[]),(2,[],[Plain "x"]),(3,[Plain "x"],[]),(4,[],[])] loopEdges [(3,[2])] + -- Written before loop, written then read during, and read after: + ,test 203 [(0,[],[Plain "x"]),(1,[],[]),(2,[],[Plain "x"]),(3,[Plain "x"],[]),(4,[Plain "x"],[])] loopEdges [(3,[2]),(4,[0,2])] + + --TODO test derefenced variables ] where latEdges :: [(Int,Int,EdgeLabel)] latEdges = [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] + loopEdges :: [(Int,Int,EdgeLabel)] + loopEdges = [(0,1,ESeq),(1,2,ESeq),(2,3,ESeq),(3,1,ESeq),(1,4,ESeq)] + blankMW :: (Int,[Var],[Var]) -> (Int, [Var], [Var], [Var]) blankMW (n,mr,dw) = (n,mr,[],dw) -- It is implied that 0 is the start, and the highest node number is the end, and the var is "x" test :: Int -> [(Int,[Var],[Var])] -> [(Int,Int,EdgeLabel)] -> [(Int,[Int])] -> Test - test testNum ns es expMap = TestCase $ assertEither ("testReachDef " ++ show testNum) (Map.fromList $ map (transformPair id Set.fromList) expMap) $ + test testNum ns es expMap = TestCase $ assertEither ("testReachDef " ++ show testNum) (Map.fromList $ map (transformPair id ((Map.singleton $ Plain "x") . Set.fromList)) expMap) $ findReachDef (buildTestFlowGraph (map blankMW ns) es 0 (maximum $ map fst3 ns) "x") (-1) fst3 :: (a,b,c) -> a