diff --git a/checks/ArrayUsageCheck.hs b/checks/ArrayUsageCheck.hs index 14adbd1..4f9ffe4 100644 --- a/checks/ArrayUsageCheck.hs +++ b/checks/ArrayUsageCheck.hs @@ -31,12 +31,13 @@ import CompState import Errors import Metadata import Omega +import Pass import ShowCode import Types import UsageCheckUtils import Utils -checkArrayUsage :: forall m. (Die m, CSM m) => (Meta, ParItems UsageLabel) -> m () +checkArrayUsage :: forall m. (Die m, CSM m, MonadIO m) => (Meta, ParItems UsageLabel) -> m () checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $ groupArrayIndexes $ transformParItems nodeVars p where @@ -92,18 +93,45 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $ case mapMaybe solve problems of -- No solutions; no worries! [] -> return () - (((lx,ly),varMapping,vm):_) -> + (((lx,ly),varMapping,vm,problem):_) -> do sol <- formatSolution varMapping (getCounterEqs vm) cx <- showCode lx cy <- showCode ly + prob <- formatProblem varMapping problem + debug $ "Found solution for problem: " ++ prob dieP m $ "Indexes of array \"" ++ userArrName ++ "\" " ++ "(\"" ++ cx ++ "\" and \"" ++ cy ++ "\") could overlap" ++ if sol /= "" then " when: " ++ sol else "" - solve :: (labels,vm,(EqualityProblem,InequalityProblem)) -> Maybe (labels,vm,VariableMapping) + solve :: (labels,vm,(EqualityProblem,InequalityProblem)) -> Maybe (labels,vm,VariableMapping,(EqualityProblem,InequalityProblem)) solve (ls,vm,(eq,ineq)) = case solveProblem eq ineq of Nothing -> Nothing - Just vm' -> Just (ls,vm,vm') + Just vm' -> Just (ls,vm,vm',(eq,ineq)) + + formatProblem :: VarMap -> (EqualityProblem, InequalityProblem) -> m String + formatProblem varToIndex (eq, ineq) + = do feqs <- mapM (showWithConst "=") $ eq + fineqs <- mapM (showWithConst ">=") $ ineq + return $ concat $ intersperse "\n" $ feqs ++ fineqs + where + showWithConst :: String -> Array CoeffIndex Integer -> m String + showWithConst op item = do text <- showEq item + return $ + (if text == "" then "0" else text) + ++ " " ++ op ++ " " ++ show (negate $ item ! 0) + + showEq :: Array CoeffIndex Integer -> m String + showEq = liftM (concat . intersperse " + ") . mapM showItem . filter ((/= 0) . snd) . tail . assocs + + showItem :: (CoeffIndex, Integer) -> m String + showItem (n, a) = case find ((== n) . snd) $ Map.assocs varToIndex of + Just (exp,_) -> showFlattenedExp exp >>* (mult ++) + Nothing -> return "" + where + mult = case a of + 1 -> "" + -1 -> "-" + _ -> show a ++ "*" formatSolution :: VarMap -> Map.Map CoeffIndex Integer -> m String formatSolution varToIndex indexToConst = do names <- mapM valOfVar $ Map.assocs varToIndex diff --git a/checks/Check.hs b/checks/Check.hs index 83ec5a7..8a4ea09 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -23,6 +23,7 @@ with this program. If not, see . module Check (checkInitVar, usageCheckPass) where import Control.Monad.Identity +import Control.Monad.Trans import Data.Generics import Data.Graph.Inductive import Data.List hiding (union) @@ -195,7 +196,7 @@ checkInitVar m graph startNode do vars <- showCodeExSet $ filterPlain' v `difference` filterPlain' vs dieP (getMeta n) $ "Variable(s) read from are not written to before-hand: " ++ vars -checkParAssignUsage :: forall m t. (CSM m, Die m, Data t) => t -> m () +checkParAssignUsage :: forall m t. (CSM m, Die m, MonadIO m, Data t) => t -> m () checkParAssignUsage = mapM_ checkParAssign . listify isParAssign where isParAssign :: A.Process -> Bool @@ -213,7 +214,7 @@ checkParAssignUsage = mapM_ checkParAssign . listify isParAssign mockedupParItems = ParItems [SeqItems [Usage Nothing Nothing $ processVarW v] | v <- vs] -checkProcCallArgsUsage :: forall m t. (CSM m, Die m, Data t) => t -> m () +checkProcCallArgsUsage :: forall m t. (CSM m, Die m, MonadIO m, Data t) => t -> m () checkProcCallArgsUsage = mapM_ checkArgs . listify isProcCall where isProcCall :: A.Process -> Bool diff --git a/common/TestHarness.hs b/common/TestHarness.hs index 6684215..4f3c433 100644 --- a/common/TestHarness.hs +++ b/common/TestHarness.hs @@ -57,7 +57,7 @@ automaticTimeTest scale fileName = readFile fileName >>* performTimeTest scale f -- Bit of a hard-hack, until usage-checking is on by default: defaultState :: CompState -defaultState = emptyState {csUsageChecking = True} +defaultState = emptyState {csUsageChecking = True , csVerboseLevel = 2 } -- | Tests if compiling the given source gives any errors. -- If there are errors, they are returned. Upon success, Nothing is returned