From bf2409d3116eab89f45cdb557f46247e9611da7d Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Fri, 14 Nov 2008 19:23:12 +0000 Subject: [PATCH] Got the unused variables pass working, but only by restarting from the root of the AST every time, rather than by navigating to the right spot --- checks/Check.hs | 14 ++++--- checks/CheckFramework.hs | 80 ++++++++++++++++++++++++++-------------- 2 files changed, 62 insertions(+), 32 deletions(-) diff --git a/checks/Check.hs b/checks/Check.hs index af6df13..9d588f4 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -280,11 +280,15 @@ checkUnusedVar = forAnyASTStruct doSpec where doSpec :: Data a => A.Structured a -> CheckOptM' (A.Structured a) () doSpec (A.Spec _ (A.Specification mspec name _) scope) - = do vars <- withChild [1] $ getCachedAnalysis' isScopeIn varsTouchedAfter - liftIO $ putStrLn $ "Vars: " ++ show vars - when (not $ (Var $ A.Variable emptyMeta name) `Set.member` vars) $ - do warnPC mspec WarnUnusedVariable $ formatCode "Unused variable: %" name - substitute scope + = do liftIO $ putStrLn $ "Found spec at: " ++ show mspec + mvars <- withChild [1] $ getCachedAnalysis' isScopeIn varsTouchedAfter + -- liftIO $ putStrLn $ "Vars: " ++ show vars + when (isNothing mvars) $ liftIO $ putStrLn $ "No analysis for: " ++ show mspec + doMaybe $ flip fmap mvars $ \vars -> do + liftIO $ putStrLn $ "Analysing: " ++ show mspec + when (not $ (Var $ A.Variable emptyMeta name) `Set.member` vars) $ + do warnPC mspec WarnUnusedVariable $ formatCode "Unused variable: %" name + substitute scope doSpec _ = return () isScopeIn :: UsageLabel -> Bool diff --git a/checks/CheckFramework.hs b/checks/CheckFramework.hs index 6ecbbd9..9341c2a 100644 --- a/checks/CheckFramework.hs +++ b/checks/CheckFramework.hs @@ -72,7 +72,8 @@ todo = error "TODO" -- 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? +-- to the root node? TODO should be possible by using the route to the root node +-- of the current graph -- -- * Modifying a node (e.g. with substitute or replaceBelow) invalidates all analyses. -- @@ -95,7 +96,9 @@ data CheckOptData = CheckOptData , nextVarsTouched :: Map.Map Node (Set.Set Var) - , flowGraph :: Maybe (FlowGraph CheckOptM UsageLabel) + , flowGraphRootsTerms :: Maybe (FlowGraph CheckOptM UsageLabel, [Node], [Node]) + + , lastValidMeta :: Meta } data FlowGraphAnalysis res = FlowGraphAnalysis @@ -106,7 +109,7 @@ data FlowGraphAnalysis res = FlowGraphAnalysis invalidateAll :: (A.AST -> A.AST) -> CheckOptData -> CheckOptData invalidateAll f d = d { ast = f (ast d), parItems = Nothing, nextVarsTouched = Map.empty, - flowGraph = Nothing} + flowGraphRootsTerms = Nothing} newtype CheckOptM a = CheckOptM (StateT CheckOptData PassM a) deriving (Monad, MonadIO) @@ -265,6 +268,8 @@ traverse typeSet f route tr -- we tack on a state parameter with a (Maybe Route) and keep scanning -- until we find the place to resume from (or go one past it, which is -- nice in case the location is no longer valid) + -- + -- TODO in future maybe I should try again to jump to the right spot -- Given a complete AST, either applies f (from parent) using apply (see -- below) if we are past the point we are meant to start at, or otherwise @@ -279,7 +284,7 @@ traverse typeSet f route tr case st of -- We are past the target start point: Nothing -> lift $ apply typeSet f (y, route) - Just targetRoute -> if targetRoute > routeId route + Just targetRoute -> if routeId route < targetRoute then return y {- Not reached start point yet -} else do put Nothing -- Blank the start point now we've found it lift $ apply typeSet f (y, route) @@ -304,7 +309,7 @@ substitute :: a -> CheckOptM' a () substitute x = CheckOptM' $ do r <- ask lift . lift . CheckOptM $ modify (invalidateAll $ routeSet r x) - lift . RestartT $ return $ Left (routeId r) + lift . RestartT $ return $ Left [] -- (routeId r) --replaceBelow :: t -> t -> CheckOptM' a () --replaceEverywhere :: t -> t -> CheckOptM' a () @@ -317,7 +322,7 @@ restartForAnyAST = CheckOptM' . lift . RestartT $ return $ Left [] runChecks :: CheckOptM () -> A.AST -> PassM A.AST runChecks (CheckOptM m) x = execStateT m (CheckOptData {ast = x, parItems = Nothing, - nextVarsTouched = Map.empty, flowGraph = Nothing}) >>* ast + nextVarsTouched = Map.empty, flowGraphRootsTerms = Nothing, lastValidMeta = emptyMeta}) >>* ast runChecksPass :: CheckOptM () -> Pass runChecksPass c = pass "" [] [] (mkM (runChecks c)) @@ -349,12 +354,15 @@ 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 = 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 - Left err -> dieP emptyMeta err - Right nodesToVars -> (liftIO $ putStrLn $ "Graph:\n" ++ show g ++ "\n\nNodes:\n" - ++ show (termNode, connNodes)) >> return nodesToVars + case findTerminals startNode g of + [] -> return Map.empty + [termNode] -> let connNodes = rdfs [termNode] g in + case flowAlgorithm (funcs g) connNodes (termNode, Set.empty) of + Left err -> dieP emptyMeta err + Right nodesToVars -> {-(liftIO $ putStrLn $ "Graph:\n" ++ show g ++ "\n\nNodes:\n" + ++ show (termNode, connNodes)) >> -}return nodesToVars + ts -> dieP (fromMaybe emptyMeta $ fmap getNodeMeta $ lab g startNode) $ "Multiple terminal nodes in flow graph" + ++ show [fmap getNodeMeta (lab g n) | n <- ts] where funcs :: FlowGraph CheckOptM UsageLabel -> GraphFuncs Node EdgeLabel (Set.Set Var) funcs g = GF @@ -379,10 +387,26 @@ varsTouchedAfter = FlowGraphAnalysis -getFlowGraph :: CheckOptM' t (FlowGraph CheckOptM UsageLabel) -getFlowGraph = getCache flowGraph (\x d -> d {flowGraph = Just x, nextVarsTouched +getFlowGraph :: CheckOptM' t (FlowGraph CheckOptM UsageLabel, [Node], [Node]) +getFlowGraph = getCache flowGraphRootsTerms (\x d -> d {flowGraphRootsTerms = Just x, nextVarsTouched = Map.empty}) generateFlowGraph +-- Makes sure that only the real last node at the end of a PROC/FUNCTION is a terminator +-- node, by joining any other nodes without successors to this node. This is a +-- bit hacky, but is needed for some of the backwards flow analysis +correctFlowGraph :: Node -> (FlowGraph CheckOptM UsageLabel, [Node], [Node]) -> FlowGraph CheckOptM UsageLabel +correctFlowGraph curNode (g, roots, terms) + = case findTerminals curNode g `intersect` terms of + [] -> empty -- Not a PROC/FUNCTION + [realTerm] -> foldl (addFakeEdge realTerm) g midTerms + where + -- The nodes that have no successors but are not the real terminator + -- For example, the node after the last condition in an IF, or a STOP node + midTerms = findTerminals curNode g \\ terms + + addFakeEdge :: Node -> FlowGraph CheckOptM UsageLabel -> Node -> FlowGraph CheckOptM UsageLabel + addFakeEdge realTerm g n = insEdge (n, realTerm, ESeq Nothing) g + getCache :: (CheckOptData -> Maybe a) -> (a -> CheckOptData -> CheckOptData) -> (A.AST -> CheckOptM a) -> CheckOptM' t a getCache getF setF genF = getCheckOptData >>= \x -> case getF x of @@ -391,29 +415,31 @@ getCache getF setF genF = getCheckOptData >>= \x -> case getF x of modifyCheckOptData (setF y) return y -getCachedAnalysis :: FlowGraphAnalysis res -> CheckOptM' t res +getCachedAnalysis :: Data t => FlowGraphAnalysis res -> CheckOptM' t (Maybe res) getCachedAnalysis = getCachedAnalysis' (const True) -- Analysis requires the latest flow graph, and uses this to produce a result -getCachedAnalysis' :: (UsageLabel -> Bool) -> FlowGraphAnalysis res -> CheckOptM' t res +getCachedAnalysis' :: Data t => (UsageLabel -> Bool) -> FlowGraphAnalysis res -> CheckOptM' t (Maybe + res) getCachedAnalysis' f an = do d <- getCheckOptData - g <- getFlowGraph - r <- askRoute >>* routeId + g'@(g,_,_) <- getFlowGraph + r <- askRoute -- 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 + case find (\(_,l) -> f (getNodeData l) && (getNodeRouteId l == routeId r)) (labNodes g) of + Nothing -> (liftIO $ putStrLn $ "Could not find node for: " ++ show (lastValidMeta + d)) >> return Nothing Just (n, _) -> case Map.lookup n (getFlowGraphAnalysis an d) of - Just y -> return y + Just y -> return (Just y) Nothing -> liftCheckOptM $ - do z <- doFlowGraphAnalysis an (g, n) + do z <- doFlowGraphAnalysis an (correctFlowGraph n g', n) CheckOptM $ modify $ addFlowGraphAnalysis an z - case Map.lookup n z of - Nothing -> dieP emptyMeta "Node not found in analysis results" - Just r -> return r + CheckOptM $ get >>* (Map.lookup n . getFlowGraphAnalysis an) -generateFlowGraph :: A.AST -> CheckOptM (FlowGraph CheckOptM UsageLabel) +generateFlowGraph :: A.AST -> CheckOptM (FlowGraph CheckOptM UsageLabel, [Node], + [Node]) generateFlowGraph x = buildFlowGraph labelUsageFunctions x >>= \g -> case g of Left err -> dieP emptyMeta err - Right (y,_,_) -> return y + Right grt -> return grt +