diff --git a/checks/CheckFramework.hs b/checks/CheckFramework.hs
index 8f39fc7..98bc8b8 100644
--- a/checks/CheckFramework.hs
+++ b/checks/CheckFramework.hs
@@ -17,7 +17,7 @@ with this program. If not, see .
-}
module CheckFramework (CheckOptM, CheckOptM', forAnyAST, substitute, restartForAnyAST,
- runChecks, runChecksPass, getFlowGraphAndMap, withChild, varsTouchedAfter,
+ runChecks, runChecksPass, getFlowGraph, withChild, varsTouchedAfter,
getCachedAnalysis, getCachedAnalysis') where
import Control.Monad.Error
@@ -47,23 +47,65 @@ import Utils
-- Temp:
todo = error "TODO"
+-- Each data analysis only works on a connected sub-graph. For forward data flow
+-- this begins at the root node (the one with no predecessors, and thus is the
+-- direct or indirect predecessor of all nodes it is connected to), for backwards
+-- data flow it begins at the terminal node (the one with no successors, and thus
+-- is the direct or indirect successor of all nodes it is connected to).
+--
+-- Each node has a unique corresponding root (the start of the PROC/FUNCTION) and
+-- similarly a unique corresponding terminal (the end of the PROC/FUNCTION). This
+-- should be guaranteed by the building of the flow graph.
+--
+-- Each analysis gives back a map from nodes to some sort of label-value (dependent
+-- on the analysis). This map is calculated for a given connected sub-graph.
+-- If the node you are looking for appears in the connected sub-graph (the keys
+-- of the map), you use that map. Since the analyses are run before unnesting
+-- takes place, it is possible to descend down the AST into a inner PROC (a different
+-- sub-graph) and then back up into the outer PROC.
+--
+-- To prevent re-running the analysis several times where there is no need, we
+-- do the following:
+--
+-- * Modifying any node invalidates the flow-graph. We currently calculate
+-- the flow-graph for the whole AST at once, but I can't see an easy way to avoid
+-- that (a more efficient way would be to just calculate the current connected
+-- sub-graph) -- perhaps we could start from the part of the AST corresponding
+-- to the root node?
+--
+-- * Modifying a node (e.g. with substitute or replaceBelow) invalidates all analyses.
+--
+-- I did have an idea that we could invalidate only analyses that contain
+-- nodes that have a route that is prefixed by that of the current node. So
+-- for example, if you modify a node with route [1,3,1], we would find all
+-- nodes with routes that match (1:3:1:_) and invalidate all currently held
+-- analysis results containing any of those nodes. This would help if for
+-- example you do a substitute in an inner PROC, we do not have to invalidate
+-- the analysis for the outer PROC. But this idea DOES NOT WORK because the nodes
+-- will change when the flow-graph is rebuilt, so we can't let the results get
+-- out of sync with the flow-graph. Unless in future we decouple the node identifiers
+-- from our use of them a bit more (but remember not to use routes, as they are
+-- not unique in the flow graph).
+
+
data CheckOptData = CheckOptData
{ ast :: A.AST
, parItems :: Maybe (ParItems ())
- -- TODO need to split this up per connected subgraphs
- , nextVarsTouched :: Maybe (Map.Map Node (Set.Set Var))
+
+ , nextVarsTouched :: Map.Map Node (Set.Set Var)
+
, flowGraph :: Maybe (FlowGraph CheckOptM UsageLabel)
}
--TODO make this a data item that fiddles with CheckOptData
data FlowGraphAnalysis res = FlowGraphAnalysis
- { getFlowGraphAnalysis :: CheckOptData -> Maybe (Map.Map Node res)
- , setFlowGraphAnalysis :: Map.Map Node res -> CheckOptData -> CheckOptData
+ { getFlowGraphAnalysis :: CheckOptData -> Map.Map Node res
+ , addFlowGraphAnalysis :: Map.Map Node res -> CheckOptData -> CheckOptData
, doFlowGraphAnalysis :: (FlowGraph CheckOptM UsageLabel, Node) -> CheckOptM (Map.Map Node res)
}
invalidateAll :: (A.AST -> A.AST) -> CheckOptData -> CheckOptData
-invalidateAll f d = d { ast = f (ast d), parItems = Nothing, nextVarsTouched = Nothing,
+invalidateAll f d = d { ast = f (ast d), parItems = Nothing, nextVarsTouched = Map.empty,
flowGraph = Nothing}
newtype CheckOptM a = CheckOptM (StateT CheckOptData PassM a)
@@ -226,7 +268,7 @@ restartForAnyAST = CheckOptM' $ RestartT $ return $ Left (Nothing, return)
runChecks :: CheckOptM () -> A.AST -> PassM A.AST
runChecks (CheckOptM m) x = execStateT m (CheckOptData {ast = x, parItems = Nothing,
- nextVarsTouched = Nothing, flowGraph = Nothing}) >>* ast
+ nextVarsTouched = Map.empty, flowGraph = Nothing}) >>* ast
runChecksPass :: CheckOptM () -> Pass
runChecksPass c = pass "" [] [] (mkM (runChecks c))
@@ -252,16 +294,6 @@ withChild ns (CheckOptM' (RestartT m)) = askRoute >>= \r -> CheckOptM' $ Restart
munge (Right x) = Right x
munge (Left _) = Left $ error "withChild wants to restart, help!"
-{-
-getVarsTouchedAfter :: CheckOptM' t (Set.Set Var)
-getVarsTouchedAfter = do
- r <- askRoute >>* routeId
- nu <- getCachedAnalysis varsTouchedAfter
- case Map.lookup r nu of
- Nothing -> dieP emptyMeta "Node not found in flow graph"
- Just vs -> return vs
--}
-
-- | Searches forward in the graph from the given node to find all the reachable
-- nodes that have no successors, i.e. the terminal nodes
findTerminals :: Node -> Gr a b -> [Node]
@@ -269,7 +301,7 @@ findTerminals n g = nub [x | x <- dfs [n] g, null (suc g x)]
varsTouchedAfter :: FlowGraphAnalysis (Set.Set Var)
varsTouchedAfter = FlowGraphAnalysis
- nextVarsTouched (\x d -> d {nextVarsTouched = Just x}) $ \(g, startNode) ->
+ nextVarsTouched (\x d -> d {nextVarsTouched = x `Map.union` nextVarsTouched d}) $ \(g, startNode) ->
let [termNode] = findTerminals startNode g
connNodes = rdfs [termNode] g in
case flowAlgorithm (funcs g) connNodes (termNode, Set.empty) of
@@ -300,11 +332,9 @@ varsTouchedAfter = FlowGraphAnalysis
---getLastPlacesWritten :: CheckOptM' t [(Route, Maybe A.Expression)]
-
-getFlowGraphAndMap :: CheckOptM' t (FlowGraph CheckOptM UsageLabel)
-getFlowGraphAndMap = getCache flowGraph (\x d -> d {flowGraph = Just x}) generateFlowGraph
--- TODO make this invalidate all the analyses
+getFlowGraph :: CheckOptM' t (FlowGraph CheckOptM UsageLabel)
+getFlowGraph = getCache flowGraph (\x d -> d {flowGraph = Just x, nextVarsTouched
+ = Map.empty}) generateFlowGraph
getCache :: (CheckOptData -> Maybe a) -> (a -> CheckOptData -> CheckOptData) -> (A.AST
-> CheckOptM a) -> CheckOptM' t a
@@ -321,22 +351,20 @@ getCachedAnalysis = getCachedAnalysis' (const True)
getCachedAnalysis' :: (UsageLabel -> Bool) -> FlowGraphAnalysis res -> CheckOptM' t res
getCachedAnalysis' f an = do
d <- getCheckOptData
- g <- getFlowGraphAndMap
+ g <- getFlowGraph
r <- askRoute >>* routeId
-- Find the node that matches our location and the given function:
case find (\(_,l) -> f (getNodeData l) && (getNodeRouteId l == r)) (labNodes g) of
Nothing -> dieP emptyMeta $ "Node not found in flow graph: " ++ show g
- Just (n, _) -> do
- liftIO $ putStrLn $ "\nUsing node: " ++ show n ++ "\n"
- m <- case getFlowGraphAnalysis an d of
+ Just (n, _) ->
+ case Map.lookup n (getFlowGraphAnalysis an d) of
Just y -> return y
Nothing -> liftCheckOptM $
do z <- doFlowGraphAnalysis an (g, n)
- CheckOptM $ modify $ setFlowGraphAnalysis an z
- return z
- case Map.lookup n m of
- Nothing -> dieP emptyMeta "Node not found in analysis results"
- Just r -> return r
+ CheckOptM $ modify $ addFlowGraphAnalysis an z
+ case Map.lookup n z of
+ Nothing -> dieP emptyMeta "Node not found in analysis results"
+ Just r -> return r
generateFlowGraph :: A.AST -> CheckOptM (FlowGraph CheckOptM UsageLabel)
generateFlowGraph x = buildFlowGraph labelUsageFunctions x >>= \g -> case g of