Changed the type of findReachDef, implemented it, and wrote some basic tests for it (that pass)

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)

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