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

Added progress messages with a little detail about the usage checking, which helps to see which part is going slow

Browse Source
This commit is contained in:
Neil Brown 2009-04-16 17:02:23 +00:00
parent 3041cda59c
commit e5001b1c6c
1 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
checks/Check.hs
View File

@ -53,11 +53,12 @@ import UsageCheckUtils
import Utils import Utils
usageCheckPass :: A.AST -> PassM A.AST usageCheckPass :: A.AST -> PassM A.AST
usageCheckPass t = do g' <- buildFlowGraph labelUsageFunctions t usageCheckPass t = do progress "- - Building flow graph"
g' <- buildFlowGraph labelUsageFunctions t
(g, roots) <- case g' of (g, roots) <- case g' of
Left err -> dieP (findMeta t) err Left err -> dieP (findMeta t) err
Right (g,rs,_) -> return (g,rs) Right (g,rs,_) -> return (g,rs)
debug "Analysing flow graph" progress "- - Analysing flow graph"
reach <- case mapM (findReachDef g) roots >>* foldl Map.union reach <- case mapM (findReachDef g) roots >>* foldl Map.union
Map.empty of Map.empty of
Left err -> dieP emptyMeta $ "findReachDef: " ++ Left err -> dieP emptyMeta $ "findReachDef: " ++
@ -69,15 +70,15 @@ usageCheckPass t = do g' <- buildFlowGraph labelUsageFunctions t
++ err ++ err
Right c -> return c Right c -> return c
g' <- labelMapWithNodeIdM (addBK reach cons g) g g' <- labelMapWithNodeIdM (addBK reach cons g) g
debug "Checking flow graph for problems" progress "- - Checking flow graph for CREW"
checkPar (nodeRep . snd) checkPar (nodeRep . snd)
(joinCheckParFunctions (joinCheckParFunctions
(checkArrayUsage NameShared) (checkArrayUsage NameShared)
(checkPlainVarUsage NameShared)) (checkPlainVarUsage NameShared))
g' g'
debug "Checking parallel assignments" progress "- - Checking parallel assignments"
checkParAssignUsage g' t checkParAssignUsage g' t
debug "Checking PROC arguments" progress "- - Checking PROC arguments"
checkProcCallArgsUsage g' t checkProcCallArgsUsage g' t
-- mapM_ (checkInitVar (findMeta t) g) roots -- mapM_ (checkInitVar (findMeta t) g) roots
debug "Completed usage checking" debug "Completed usage checking"
@ -534,7 +535,8 @@ checkParAssignUsage g = mapM_ checkParAssign . findAllProcess isParAssign g
-- are distinct. So we check plain variables, and array variables -- are distinct. So we check plain variables, and array variables
checkParAssign :: (A.Process, (BK, UsageLabel)) -> m () checkParAssign :: (A.Process, (BK, UsageLabel)) -> m ()
checkParAssign (A.Assign m vs _, (bk, _)) checkParAssign (A.Assign m vs _, (bk, _))
= do checkPlainVarUsage NameShared (m, mockedupParItems) = do debug $ "Checking assignment at: " ++ show m
checkPlainVarUsage NameShared (m, mockedupParItems)
checkArrayUsage NameShared (m, mockedupParItems) checkArrayUsage NameShared (m, mockedupParItems)
where where
mockedupParItems :: ParItems (BK, UsageLabel) mockedupParItems :: ParItems (BK, UsageLabel)