suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changed checkInitVar to use the new CheckFramework stuff, and forAnyFlow (it still passes all its tests)

Browse Source
This commit is contained in:
Neil Brown 2008-11-20 13:02:38 +00:00
parent 0733eb6c11
commit 53240825dd
1 changed files with 29 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
checks/Check.hs
View File

@ -20,7 +20,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
-- the control-flow graph stuff, hence the use of functions that match the dictionary -- the control-flow graph stuff, hence the use of functions that match the dictionary
-- of functions in FlowGraph. This is also why we don't drill down into processes; -- of functions in FlowGraph. This is also why we don't drill down into processes;
-- the control-flow graph means that we only need to concentrate on each node that isn't nested. -- the control-flow graph means that we only need to concentrate on each node that isn't nested.
module Check (checkInitVar, checkInitVarPass, usageCheckPass, checkUnusedVar) where module Check (checkInitVarPass, usageCheckPass, checkUnusedVar) where
import Control.Monad.Identity import Control.Monad.Identity
import Control.Monad.Trans import Control.Monad.Trans
@ -69,7 +69,7 @@ usageCheckPass t = do g' <- buildFlowGraph labelUsageFunctions t
$ labelMapWithNodeId (addBK reach cons g) g $ labelMapWithNodeId (addBK reach cons g) g
checkParAssignUsage t checkParAssignUsage t
checkProcCallArgsUsage t checkProcCallArgsUsage t
mapM_ (checkInitVar (findMeta t) g) roots -- mapM_ (checkInitVar (findMeta t) g) roots
return t return t
addBK :: Map.Map Node (Map.Map Var (Set.Set (Maybe A.Expression))) -> addBK :: Map.Map Node (Map.Map Var (Set.Set (Maybe A.Expression))) ->
@ -185,68 +185,51 @@ showCodeExSet (NormalSet s)
checkInitVarPass :: Pass checkInitVarPass :: Pass
checkInitVarPass = pass "checkInitVar" [] [] checkInitVarPass = pass "checkInitVar" [] []
(passOnlyOnAST "checkInitVar" $ (passOnlyOnAST "checkInitVar" $ runChecks checkInitVar)
\t -> do g' <- buildFlowGraph labelUsageFunctions t
(g, roots) <- case g' of
Left err -> dieP (findMeta t) err
Right (g,rs,_) -> return (g,rs)
mapM_ (checkInitVar (findMeta t) g) roots
return t)
-- | Checks that no variable is used uninitialised. That is, it checks that every variable is written to before it is read. -- | Checks that no variable is used uninitialised. That is, it checks that every variable is written to before it is read.
checkInitVar :: forall m. (Monad m, Die m, Warn m, CSMR m) => Meta -> FlowGraph m UsageLabel -> Node -> m () checkInitVar :: CheckOptM ()
checkInitVar m graph startNode checkInitVar = forAnyFlowNode
= do startLabel <- checkJust (Just m, "Could not find starting node in the control-flow graph") (\(g, roots, _) -> sequence
(lab graph startNode) >>* writeNode [case flowAlgorithm (graphFuncs g) (dfs [r] g) (r, writeNode (fromJust $ lab g r)) of
vwb <- case flowAlgorithm graphFuncs connectedNodes (startNode, startLabel) of Left err -> dieP emptyMeta err
Left err -> dieP m $ "Error building control-flow graph: " ++ err Right x -> return x
Right x -> return x | r <- roots] >>* foldl Map.union Map.empty)
-- Label the connected nodes: checkInitVar'
-- We should always be able to find the labels for the graphs, but we still use checkJust rather than fromJust -- We check that for every variable read in each node, it has already been written to by then
labelledConnectedNodes <- flip mapM connectedNodes (\n -> seqPair (return n,
checkJust (Just m, "Could not find label for node in checkInitVar") (lab graph n)))
-- vwb is a map from Node to a set of Vars that have been written by that point
-- Now we check that for every variable read in each node, it has already been written to by then
mapM_ (checkInitVar' vwb) (map readNode labelledConnectedNodes)
where where
connectedNodes = dfs [startNode] graph
-- Gets all variables read-from in a particular node, and the node identifier -- Gets all variables read-from in a particular node, and the node identifier
readNode :: (Node, FNode m UsageLabel) -> (Node, ExSet Var) readNode :: UsageLabel -> ExSet Var
readNode (n, nd) = (n,NormalSet $ readVars $ nodeVars $ getNodeData nd) readNode u = NormalSet $ readVars $ nodeVars u
-- Gets all variables written-to in a particular node -- Gets all variables written-to in a particular node
writeNode :: FNode m UsageLabel -> ExSet Var writeNode :: Monad m => FNode m UsageLabel -> ExSet Var
writeNode nd = NormalSet $ Map.keysSet $ 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: -- Nothing is treated as if were the set of all possible variables:
nodeFunction :: (Node, EdgeLabel) -> ExSet Var -> Maybe (ExSet Var) -> ExSet Var nodeFunction :: Monad m => FlowGraph m UsageLabel -> (Node, EdgeLabel) -> ExSet Var -> Maybe (ExSet Var) -> ExSet Var
nodeFunction (n,_) inputVal Nothing = union inputVal (maybe emptySet writeNode (lab graph n)) nodeFunction graph (n,_) inputVal Nothing = union inputVal (maybe emptySet writeNode (lab graph n))
nodeFunction (n, EEndPar _) inputVal (Just prevAgg) = unions [inputVal,prevAgg,maybe emptySet writeNode (lab graph n)] nodeFunction graph (n, EEndPar _) inputVal (Just prevAgg) = unions [inputVal,prevAgg,maybe emptySet writeNode (lab graph n)]
nodeFunction (n, _) inputVal (Just prevAgg) = intersection prevAgg $ union inputVal (maybe emptySet writeNode (lab graph n)) nodeFunction graph (n, _) inputVal (Just prevAgg) = intersection prevAgg $ union inputVal (maybe emptySet writeNode (lab graph n))
graphFuncs :: GraphFuncs Node EdgeLabel (ExSet Var) graphFuncs :: Monad m => FlowGraph m UsageLabel -> GraphFuncs Node EdgeLabel (ExSet Var)
graphFuncs = GF graphFuncs graph = GF
{ {
nodeFunc = nodeFunction nodeFunc = nodeFunction graph
,nodesToProcess = lpre graph ,nodesToProcess = lpre graph
,nodesToReAdd = lsuc graph ,nodesToReAdd = lsuc graph
,defVal = Everything ,defVal = Everything
,userErrLabel = ("for node at: " ++) . show . fmap getNodeMeta . lab graph ,userErrLabel = ("for node at: " ++) . show . fmap getNodeMeta . lab graph
} }
getMeta :: Node -> Meta checkInitVar' :: CheckOptFlowM (ExSet Var) ()
getMeta n = case lab graph n of checkInitVar'
Just nd -> getNodeMeta nd = do (v, vs) <- getFlowLabel >>* transformPair readNode (fromMaybe emptySet)
_ -> emptyMeta
checkInitVar' :: Map.Map Node (ExSet Var) -> (Node, ExSet Var) -> m ()
checkInitVar' writtenMap (n,v)
= let vs = fromMaybe emptySet (Map.lookup n writtenMap) in
-- The read-from set should be a subset of the written-to set: -- The read-from set should be a subset of the written-to set:
if filterPlain' v `isSubsetOf` filterPlain' vs then return () else if filterPlain' v `isSubsetOf` filterPlain' vs then return () else
do vars <- showCodeExSet $ filterPlain' v `difference` filterPlain' vs do vars <- showCodeExSet $ filterPlain' v `difference` filterPlain' vs
warnP (getMeta n) WarnUninitialisedVariable $ "Variable(s) read from are not written to before-hand: " ++ vars m <- getFlowMeta
warnP m WarnUninitialisedVariable $ "Variable(s) read from are not written to before-hand: " ++ vars
checkParAssignUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t) => t -> m () checkParAssignUsage :: forall m t. (CSMR m, Die m, MonadIO m, Data t) => t -> m ()
checkParAssignUsage = mapM_ checkParAssign . listify isParAssign checkParAssignUsage = mapM_ checkParAssign . listify isParAssign