[commit: ghc] master: Improve debug printing/warnings (6e0c0fd)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6e0c0fd2e09c552bf38e22645347dbb2e7327e8e/ghc

>---------------------------------------------------------------

commit 6e0c0fd2e09c552bf38e22645347dbb2e7327e8e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Jan 11 09:02:25 2016 +0000

    Improve debug printing/warnings


>---------------------------------------------------------------

6e0c0fd2e09c552bf38e22645347dbb2e7327e8e
 compiler/typecheck/TcRnTypes.hs  | 4 +++-
 compiler/typecheck/TcSMonad.hs   | 5 ++++-
 compiler/typecheck/TcSimplify.hs | 3 ++-
 3 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index a2f4045..a7895e7 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -1773,7 +1773,9 @@ instance Outputable Ct where
          CTyEqCan {}      -> text "CTyEqCan"
          CFunEqCan {}     -> text "CFunEqCan"
          CNonCanonical {} -> text "CNonCanonical"
-         CDictCan {}      -> text "CDictCan"
+         CDictCan { cc_pend_sc = pend_sc }
+            | pend_sc   -> text "CDictCan(psc)"
+            | otherwise -> text "CDictCan"
          CIrredEvCan {}   -> text "CIrredEvCan"
          CHoleCan { cc_occ = occ } -> text "CHoleCan:" <+> ppr occ
 
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index 099be19..0ad02e5 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -13,7 +13,8 @@ module TcSMonad (
     updWorkListTcS,
 
     -- The TcS monad
-    TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, failTcS,
+    TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds,
+    failTcS, warnTcS,
     runTcSEqualities,
     nestTcS, nestImplicTcS,
 
@@ -2319,7 +2320,9 @@ wrapWarnTcS :: TcM a -> TcS a
 wrapWarnTcS = wrapTcS
 
 failTcS, panicTcS :: SDoc -> TcS a
+warnTcS           :: SDoc -> TcS ()
 failTcS      = wrapTcS . TcM.failWith
+warnTcS      = wrapTcS . TcM.addWarn
 panicTcS doc = pprPanic "TcCanonical" doc
 
 traceTcS :: String -> SDoc -> TcS ()
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index c85444e..4d93912 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -1018,7 +1018,7 @@ simpl_loop n limit floated_eqs no_new_scs
   = return wc  -- Done!
 
   | n `intGtLimit` limit
-  = failTcS (hang (ptext (sLit "solveWanteds: too many iterations")
+  = do { warnTcS (hang (ptext (sLit "solveWanteds: too many iterations")
                    <+> parens (ptext (sLit "limit =") <+> ppr limit))
                 2 (vcat [ ptext (sLit "Unsolved:") <+> ppr wc
                         , ppUnless (isEmptyBag floated_eqs) $
@@ -1027,6 +1027,7 @@ simpl_loop n limit floated_eqs no_new_scs
                           ptext (sLit "New superclasses found")
                         , ptext (sLit "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit")
                   ]))
+       ; return wc }
 
   | otherwise
   = do { traceTcS "simpl_loop, iteration" (int n)