From 2a15f4ef5f3ff920c0e5988ce1d822fc06aa4d8a Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Wed, 12 Nov 2008 16:54:00 +0000 Subject: [PATCH] Filled in all the gaps such that the CheckTest tests now run (including some debug output, for now) One of the tests fails at the moment because the specification node has two entries associated with it in the flowgraph. One is the scope-in and one is the scope-out. I think the analysis is currently picking the scope-out node and looking beyond that, where -- surprise, surprise -- the variable is not used again. So I need some easy way of telling the flow analyses which of the two nodes I want to start from, in this case and other ones where I also add two nodes related to the same point in the AST. --- checks/Check.hs | 1 + checks/CheckFramework.hs | 47 ++++++++++++++++++++++++----- checks/UsageCheckUtils.hs | 2 +- common/GenericUtils.hs | 3 ++ common/Utils.hs | 3 ++ flow/FlowUtils.hs | 3 +- transformations/ImplicitMobility.hs | 1 + 7 files changed, 51 insertions(+), 9 deletions(-) diff --git a/checks/Check.hs b/checks/Check.hs index 3c7bad8..d8b657d 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -279,6 +279,7 @@ checkUnusedVar :: CheckOptM () checkUnusedVar = forAnyAST $ \(A.Spec _ (A.Specification _ name _) scope :: A.Structured A.Process) -> do vars <- withChild [1] $ getVarsTouchedAfter + liftIO $ putStrLn $ "Vars: " ++ show vars when (not $ (Var $ A.Variable emptyMeta name) `Set.member` vars) $ substitute scope diff --git a/checks/CheckFramework.hs b/checks/CheckFramework.hs index 3974eef..c06beab 100644 --- a/checks/CheckFramework.hs +++ b/checks/CheckFramework.hs @@ -23,15 +23,18 @@ import Control.Monad.Error import Control.Monad.Reader import Control.Monad.State import Data.Generics -import Data.Graph.Inductive (Node) +import Data.Graph.Inductive import qualified Data.Map as Map import Data.Maybe import qualified Data.Set as Set import Control.Exception import qualified AST as A +import CompState import Errors +import FlowAlgorithms import FlowGraph +import FlowUtils import GenericUtils import Metadata import Pass @@ -54,7 +57,8 @@ data CheckOptData = CheckOptData data FlowGraphAnalysis res = FlowGraphAnalysis { getFlowGraphAnalysis :: CheckOptData -> Maybe res , setFlowGraphAnalysis :: res -> CheckOptData -> CheckOptData - , doFlowGraphAnalysis :: (FlowGraph CheckOptM UsageLabel, Node) -> CheckOptM res + , doFlowGraphAnalysis :: (FlowGraph CheckOptM UsageLabel, Map.Map [Int] Node, + Node) -> CheckOptM res } invalidateAll :: (A.AST -> A.AST) -> CheckOptData -> CheckOptData @@ -67,6 +71,9 @@ newtype CheckOptM a = CheckOptM (StateT CheckOptData PassM a) instance Die CheckOptM where dieReport = CheckOptM . lift . dieReport +instance CSMR CheckOptM where + getCompState = CheckOptM . lift $ getCompState + deCheckOptM :: CheckOptM a -> StateT CheckOptData PassM a deCheckOptM (CheckOptM x) = x @@ -254,8 +261,33 @@ getVarsTouchedAfter = do varsTouchedAfter :: FlowGraphAnalysis (Map.Map [Int] (Set.Set Var)) varsTouchedAfter = FlowGraphAnalysis - nextVarsTouched (\x d -> d {nextVarsTouched = Just x}) $ - todo + nextVarsTouched (\x d -> d {nextVarsTouched = Just x}) $ \(g, lu, startNode) -> + case flowAlgorithm (funcs g) (rdfs [startNode] g) (startNode, Set.empty) of + Left err -> dieP emptyMeta err + Right nodesToVars -> (liftIO $ putStrLn $ show g) >> return (Map.fromList [(y, z) | + (Just y, z) <- map (\(k,v) -> (reverseLookup k lu, v)) $ Map.toList nodesToVars]) + where + funcs :: FlowGraph CheckOptM UsageLabel -> GraphFuncs Node EdgeLabel (Set.Set Var) + funcs g = GF + { nodeFunc = iterate g + -- Backwards data flow: + , nodesToProcess = lsuc g + , nodesToReAdd = lpre g + , defVal = Set.empty + , userErrLabel = ("for node at: " ++) . show . fmap getNodeMeta . lab g + } + + iterate :: FlowGraph CheckOptM UsageLabel -> + (Node, EdgeLabel) -> Set.Set Var -> Maybe (Set.Set Var) -> Set.Set Var + iterate g node prevVars maybeVars = case lab g (fst node) of + Just ul -> + let vs = nodeVars $ getNodeData ul + readFromVars = readVars vs + writtenToVars = writtenVars vs + addTo = fromMaybe prevVars maybeVars + in (readFromVars `Set.union` addTo) `Set.union` Map.keysSet writtenToVars + Nothing -> error "Node label not found in calculateUsedAgainAfter" + --getLastPlacesWritten :: CheckOptM' t [(Route, Maybe A.Expression)] @@ -281,12 +313,13 @@ getCachedAnalysis an = getCheckOptData >>= \x -> case getFlowGraphAnalysis an x r <- askRoute case Map.lookup (routeId r) nodes of Just n -> liftCheckOptM $ - do z <- doFlowGraphAnalysis an (g, n) + do z <- doFlowGraphAnalysis an (g, nodes, n) CheckOptM $ modify $ setFlowGraphAnalysis an z return z Nothing -> dieP emptyMeta "Node not found in flow graph" generateFlowGraph :: A.AST -> CheckOptM (FlowGraph CheckOptM UsageLabel, Map.Map [Int] Node) -generateFlowGraph x = buildFlowGraph todo x >>= \g -> case g of +generateFlowGraph x = buildFlowGraph labelUsageFunctions x >>= \g -> case g of Left err -> dieP emptyMeta err - Right (y,_,_) -> return (y, todo) + Right (y,_,_) -> return (y, Map.fromList $ + [(getNodeRouteId l, n)| (n, l) <- labNodes y]) diff --git a/checks/UsageCheckUtils.hs b/checks/UsageCheckUtils.hs index 58b24df..9098a5b 100644 --- a/checks/UsageCheckUtils.hs +++ b/checks/UsageCheckUtils.hs @@ -77,7 +77,7 @@ data UsageLabel = Usage } instance Show UsageLabel where - show = const "" + show x = "Vars{" ++ show (nodeVars x) ++ "}" transformParItems :: (a -> b) -> ParItems a -> ParItems b transformParItems f (SeqItems xs) = SeqItems $ map f xs diff --git a/common/GenericUtils.hs b/common/GenericUtils.hs index 460234a..28e790d 100644 --- a/common/GenericUtils.hs +++ b/common/GenericUtils.hs @@ -171,6 +171,9 @@ instance Eq (Route inner outer) where instance Ord (Route inner outer) where compare (Route xns _) (Route yns _) = compare xns yns +instance Show (Route inner outer) where + show (Route ns _) = "Route " ++ show ns + routeId :: Route inner outer -> [Int] routeId (Route ns _) = ns diff --git a/common/Utils.hs b/common/Utils.hs index 29c41ee..6a830e6 100644 --- a/common/Utils.hs +++ b/common/Utils.hs @@ -349,3 +349,6 @@ eitherToMaybe = either (const Nothing) Just labelMapWithNodeId :: DynGraph gr => (Node -> a -> b) -> gr a c -> gr b c labelMapWithNodeId f = gmap (\(x,n,l,y) -> (x,n,f n l,y)) + +reverseLookup :: (Ord k, Eq v) => v -> Map.Map k v -> Maybe k +reverseLookup x m = lookup x $ map revPair $ Map.toList m diff --git a/flow/FlowUtils.hs b/flow/FlowUtils.hs index 5186781..a5f9f27 100644 --- a/flow/FlowUtils.hs +++ b/flow/FlowUtils.hs @@ -58,6 +58,7 @@ data AlterAST m structType = |AlterReplicator (ASTModifier m A.Replicator structType) |AlterSpec (ASTModifier m A.Specification structType) |AlterNothing [Int] + deriving (Show) data Monad mAlter => FNode' structType mAlter label = Node (Meta, label, AlterAST mAlter structType) @@ -71,7 +72,7 @@ type FNode mAlter label = FNode' () mAlter label --type FEdge = (Node, EdgeLabel, Node) instance (Monad m, Show a) => Show (FNode' b m a) where - show (Node (m,x,_)) = (filter ((/=) '\"')) $ show m ++ ":" ++ show x + show (Node (m,x,r)) = (filter ((/=) '\"')) $ show m ++ ":" ++ show x ++ "<" ++ show r type FlowGraph' mAlter label structType = Gr (FNode' structType mAlter label) EdgeLabel diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs index bbdf1bb..c667b20 100644 --- a/transformations/ImplicitMobility.hs +++ b/transformations/ImplicitMobility.hs @@ -101,6 +101,7 @@ calculateUsedAgainAfter g startNode 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: -- seqeach (..) {int:x; ... x = 3;} -- will look like x is used again on the next loop iteration