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

Added a couple of filter calls to the usage checking to speed it up

Browse Source 
It now removes empty sets of (relevant) background knowledge to avoid needlessly creating lots of problems (thousands!) when it only needs one, and also stopped it checking array usage when there's at most one written-to/read-from index.

Fixes #90
This commit is contained in:
Neil Brown 2009-04-04 08:52:41 +00:00
parent f755458545
commit c9f9eb8587
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
checks/ArrayUsageCheck.hs
View File

@ -34,6 +34,7 @@ module ArrayUsageCheck (
import Control.Monad.Error import Control.Monad.Error
import Control.Monad.State import Control.Monad.State
import Data.Array.IArray import Data.Array.IArray
import qualified Data.Foldable as F
import Data.Generics hiding (GT) import Data.Generics hiding (GT)
import Data.Int import Data.Int
import Data.List import Data.List
@ -98,8 +99,10 @@ findRepSolutions reps bks
-- for any overlapping array indices. -- for any overlapping array indices.
checkArrayUsage :: forall m. (Die m, CSMR m, MonadIO m) => NameAttr -> (Meta, ParItems (BK, UsageLabel)) -> m () checkArrayUsage :: forall m. (Die m, CSMR m, MonadIO m) => NameAttr -> (Meta, ParItems (BK, UsageLabel)) -> m ()
checkArrayUsage sharedAttr (m,p) checkArrayUsage sharedAttr (m,p)
= do indexes <- groupArrayIndexes $ fmap (transformPair id nodeVars) p = do debug $ "checkArrayUsage: " ++ show m
mapM_ (checkIndexes m) $ Map.toList indexes indexes <- groupArrayIndexes $ fmap (transformPair id nodeVars) p
mapM_ (checkIndexes m) $ Map.toList $ Map.filter
((<= 1) . length . map (\(_,w,r) -> w++r) . F.toList) indexes
where where
getDecl :: UsageLabel -> Maybe String getDecl :: UsageLabel -> Maybe String
getDecl = join . fmap getScopeIn . nodeDecl getDecl = join . fmap getScopeIn . nodeDecl
@ -172,7 +175,7 @@ checkArrayUsage sharedAttr (m,p)
Right [] -> return () -- No problems to work with Right [] -> return () -- No problems to work with
Right problems -> do Right problems -> do
probs <- formatProblems [(vm, prob) | (_,vm,prob) <- problems] probs <- formatProblems [(vm, prob) | (_,vm,prob) <- problems]
debug $ "Problems in checkArrayUsage:\n" ++ probs debug $ "Problems in checkArrayUsage" ++ show m ++ ":\n" ++ probs
case mapMaybe solve problems of case mapMaybe solve problems of
-- No solutions; no worries! -- No solutions; no worries!
[] -> return () [] -> return ()
@ -544,7 +547,9 @@ makeEquations accesses bound
where where
lookupBK :: [A.Name] -> (A.Expression, [ModuloCase], BK') -> Either String lookupBK :: [A.Name] -> (A.Expression, [ModuloCase], BK') -> Either String
[(EqualityProblem, InequalityProblem)] [(EqualityProblem, InequalityProblem)]
lookupBK reps (e,_,bk) = mapM (foldl (liftM2 accumProblem) (return ([],[])) . map snd . lookupBK reps (e,_,bk) = liftM (filter (\x ->
(not $ null $ fst x) || (not $ null $ snd x))) $
mapM (foldl (liftM2 accumProblem) (return ([],[])) . map snd .
filter (\(v,_) -> v `elem` vs || v `elem` reps') . Map.toList) bk filter (\(v,_) -> v `elem` vs || v `elem` reps') . Map.toList) bk
where where
reps' :: [Var] reps' :: [Var]