Added the ability to neatly print out a problem as a debug message

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 "<unknown>"
+          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

checks/Check.hs

@@ -23,6 +23,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 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

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