From 7e0bc775bfb1da5590a8a6317bdd51a1ff241cfe Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 5 Jun 2008 20:30:44 +0000 Subject: [PATCH] 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 | 10 ++++---- checks/UsageCheckTest.hs | 5 ++-- checks/UsageCheckUtils.hs | 37 ++++++++++++++++------------- transformations/ImplicitMobility.hs | 2 +- 4 files changed, 31 insertions(+), 23 deletions(-) diff --git a/checks/Check.hs b/checks/Check.hs index 7bdf267..f85e881 100644 --- a/checks/Check.hs +++ b/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 () diff --git a/checks/UsageCheckTest.hs b/checks/UsageCheckTest.hs index 69c5c12..e87486b 100644 --- a/checks/UsageCheckTest.hs +++ b/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 diff --git a/checks/UsageCheckUtils.hs b/checks/UsageCheckUtils.hs index 998e592..998595d 100644 --- a/checks/UsageCheckUtils.hs +++ b/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 diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs index 94eb60a..a023f0c 100644 --- a/transformations/ImplicitMobility.hs +++ b/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: