Changed the writtenVars entry of Vars to be a map from variables to (assigned-from) expressions

The expressions are optional (wrapped in a Maybe type)

checks/Check.hs

@@ -98,8 +98,9 @@ checkPlainVarUsage (m, p) = check p
              diePC m $ formatCode
                "The following variables are written-to and read-from in separate branches of a PAR: %" writtenAndRead
       where
-        writtenTwice = filterPlain $ writtenVars item `Set.intersection` writtenVars otherVars
-        writtenAndRead = filterPlain $ writtenVars item `Set.intersection` readVars otherVars
+        writtenTwice = filterPlain $ Map.keysSet (writtenVars item) `Set.intersection` Map.keysSet
+          (writtenVars otherVars)
+        writtenAndRead = filterPlain $ Map.keysSet (writtenVars item) `Set.intersection` readVars otherVars
         otherVars = foldUnionVars rest
 
 -- | A custom Set wrapper that allows for easy representation of the "everything" set.
@@ -166,7 +167,7 @@ checkInitVar m graph startNode
   
     -- Gets all variables written-to in a particular node
     writeNode :: FNode m UsageLabel -> ExSet Var
-    writeNode nd = NormalSet $ writtenVars $ nodeVars $ getNodeData nd
+    writeNode nd = NormalSet $ Map.keysSet $ writtenVars $ nodeVars $ getNodeData nd
     
     -- Nothing is treated as if were the set of all possible variables:
     nodeFunction :: (Node, EdgeLabel) -> ExSet Var -> Maybe (ExSet Var) -> ExSet Var
@@ -212,7 +213,8 @@ checkParAssignUsage = mapM_ checkParAssign . listify isParAssign
            checkArrayUsage (m, mockedupParItems)
       where
         mockedupParItems :: ParItems UsageLabel
-        mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing $ processVarW v] | v <- vs]
+        mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing $ processVarW v
+          Nothing] | v <- vs]
 
 
 checkProcCallArgsUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t) => t -> m ()

checks/UsageCheckTest.hs

@@ -114,7 +114,7 @@ testGetVarProc = TestList (map doTest tests)
                         (_, Left err) ->
                           testFailure $ name ++ " failed: " ++ show err
                         (_, Right result) ->
-                          assertEqual name (vars r w u) result
+                          assertEqual name (vars r (zip w $ repeat Nothing) u) result
     where
       name = "testGetVarProc" ++ show index
 
@@ -136,7 +136,8 @@ buildTestFlowGraph ns es start end v
       ([(-1,start,ESeq),(end,-2,ESeq)] ++ es)
   where
     transNode :: (Int, [Var], [Var]) -> (Int, FNode TestM UsageLabel)
-    transNode (n,r,w) = (n,makeTestNode emptyMeta (Usage Nothing Nothing $ vars r w []))
+    transNode (n,r,w) = (n,makeTestNode emptyMeta (Usage Nothing Nothing $ vars r (zip
+      w $ repeat Nothing) []))
 
 testInitVar :: Test
 testInitVar = TestList

checks/UsageCheckUtils.hs

@@ -21,6 +21,7 @@ module UsageCheckUtils (Decl(..), emptyVars, flattenParItems, foldUnionVars, get
 import Control.Monad.Writer (tell)
 import Data.Generics hiding (GT)
 import Data.List
+import qualified Data.Map as Map
 import Data.Maybe
 import qualified Data.Set as Set
 
@@ -54,7 +55,7 @@ instance ShowRain (Set.Set Var) where
 
 data Vars = Vars {
   readVars :: Set.Set Var
-  ,writtenVars :: Set.Set Var
+  ,writtenVars :: Map.Map Var (Maybe A.Expression)
   ,usedVars :: Set.Set Var -- for channels, barriers, etc
 } deriving (Eq, Show)
 
@@ -92,22 +93,22 @@ flattenParItems (RepParItem _ p) = flattenParItems p
 
 
 emptyVars :: Vars
-emptyVars = Vars Set.empty Set.empty Set.empty
+emptyVars = Vars Set.empty Map.empty Set.empty
 
 mkReadVars :: [Var] -> Vars
-mkReadVars ss = Vars (Set.fromList ss) Set.empty Set.empty
+mkReadVars ss = Vars (Set.fromList ss) Map.empty Set.empty
 
-mkWrittenVars :: [Var] -> Vars
-mkWrittenVars ss = Vars Set.empty (Set.fromList ss) Set.empty
+mkWrittenVars :: [(Var, Maybe A.Expression)] -> Vars
+mkWrittenVars ss = Vars Set.empty (Map.fromList ss) Set.empty
 
 mkUsedVars :: [Var] -> Vars
-mkUsedVars vs = Vars Set.empty Set.empty (Set.fromList vs)
+mkUsedVars vs = Vars Set.empty Map.empty (Set.fromList vs)
 
-vars :: [Var] -> [Var] -> [Var] -> Vars
-vars mr mw  u = Vars (Set.fromList mr) (Set.fromList mw) (Set.fromList u)
+vars :: [Var] -> [(Var, Maybe A.Expression)] -> [Var] -> Vars
+vars mr mw  u = Vars (Set.fromList mr) (Map.fromList mw) (Set.fromList u)
 
 unionVars :: Vars -> Vars -> Vars
-unionVars (Vars mr mw u) (Vars mr' mw' u') = Vars (mr `Set.union` mr') (mw `Set.union` mw') (u `Set.union` u')
+unionVars (Vars mr mw u) (Vars mr' mw' u') = Vars (mr `Set.union` mr') (mw `Map.union` mw') (u `Set.union` u')
 
 foldUnionVars :: [Vars] -> Vars
 foldUnionVars = foldl unionVars emptyVars
@@ -125,7 +126,7 @@ getVarProc (A.Assign _ vars expList)
         --Join together:
       = return $ unionVars
           --The written-to variables on the LHS:
-          (mapUnionVars processVarW vars) 
+          (mapUnionVars (uncurry processVarW) $ annotateVars expList vars) 
           --All variables read on the RHS:
           (getVarExpList expList)
 getVarProc (A.Output _ chanVar outItems)
@@ -141,9 +142,9 @@ getVarProc (A.Input _ chanVar (A.InputSimple _ iis))
   where
     getVarInputItem :: A.InputItem -> Vars
     getVarInputItem (A.InCounted _ cv av)
-        = mkWrittenVars [variableToVar cv,variableToVar av]
+        = mkWrittenVars [(variableToVar cv, Nothing), (variableToVar av, Nothing)]
     getVarInputItem (A.InVariable _ v)
-        = mkWrittenVars [variableToVar v]
+        = mkWrittenVars [(variableToVar v, Nothing)]
 getVarProc p@(A.ProcCall _ _ _)
     = getVarProcCall p >>* foldUnionVars
 getVarProc _ = return emptyVars
@@ -161,7 +162,7 @@ getVarActual _ (A.ActualExpression e) = return $ getVarExp e
 getVarActual (A.Formal am _ _) (A.ActualVariable v)
     = case am of
         A.ValAbbrev -> return $ processVarR v
-        _ -> return $ processVarW v
+        _ -> return $ processVarW v Nothing
 
     {-
       Near the beginning, this piece of code was too clever for itself and applied processVarW using "everything".
@@ -173,8 +174,8 @@ getVarActual (A.Formal am _ _) (A.ActualVariable v)
     -}    
     
     --Pull out all the subscripts into the read category, but leave the given var in the written category:
-processVarW :: A.Variable -> Vars
-processVarW v = mkWrittenVars [variableToVar v]
+processVarW :: A.Variable -> Maybe A.Expression -> Vars
+processVarW v me = mkWrittenVars [(variableToVar v, me)]
     
 processVarR :: A.Variable -> Vars
 processVarR v = mkReadVars [variableToVar v]
@@ -185,6 +186,10 @@ processVarUsed v = mkUsedVars [variableToVar v]
 variableToVar :: A.Variable -> Var
 variableToVar = Var
 
+annotateVars :: A.ExpressionList -> [A.Variable] -> [(A.Variable, Maybe A.Expression)]
+annotateVars (A.FunctionCallList {}) vs = zip vs (repeat Nothing)
+annotateVars (A.ExpressionList _ es) vs = zip vs (map Just es ++ repeat Nothing)
+
 getVarExpList :: A.ExpressionList -> Vars
 getVarExpList (A.ExpressionList _ es) = foldUnionVars $ map getVarExp es
 getVarExpList (A.FunctionCallList _ _ es) = foldUnionVars $ map getVarExp es --TODO record stuff in passed as well?
@@ -211,7 +216,7 @@ getVarFormals m = mapUnionVars (getVarFormal m)
     -- We treat formal parameters as being written-to, so that they
     -- appear initialised at the beginning of the function
     getVarFormal :: Meta -> A.Formal -> Vars
-    getVarFormal m (A.Formal _ _ n) = processVarW $ A.Variable m n
+    getVarFormal m (A.Formal _ _ n) = processVarW (A.Variable m n) Nothing
 
 getVarRepExp :: A.Replicator -> Vars
 getVarRepExp (A.For _ e0 e1) = getVarExp e0 `unionVars` getVarExp e1

transformations/ImplicitMobility.hs

@@ -97,7 +97,7 @@ calculateUsedAgainAfter g startNode
             readFromVars = readVars vs
             writtenToVars = writtenVars vs
             addTo = fromMaybe prevVars maybeVars
-        in (readFromVars `Set.union` addTo) `Set.difference` writtenToVars
+        in (readFromVars `Set.union` addTo) `Set.difference` Map.keysSet writtenToVars
       Nothing -> error "Node label not found in calculateUsedAgainAfter"
 
 --TODO rememember to take note of declarations/scope, otherwise this: