[commit: ghc] master: Better constraint-solver tracing (9db4951)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/9db49518b06584e2ee79aa16ad6f1aabc02775a9/ghc

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

commit 9db49518b06584e2ee79aa16ad6f1aabc02775a9
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Nov 21 10:28:56 2013 +0000

    Better constraint-solver tracing


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

9db49518b06584e2ee79aa16ad6f1aabc02775a9
 compiler/typecheck/TcCanonical.lhs |    7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index b49e0b9..916a6cb 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -1053,7 +1053,7 @@ canEqLeaf :: CtLoc -> CtEvidence
 
 canEqLeaf loc ev s1 s2
   | cls1 `reOrient` cls2
-  = do { traceTcS "canEqLeaf (reorienting)" $ ppr ev <+> dcolon <+> pprEq s1 s2
+  = do { traceTcS "canEqLeaf (reorienting)" doc
        ; let xcomp [x] = EvCoercion (mkTcSymCo (evTermCoercion x))
              xcomp _ = panic "canEqLeaf: can't happen"
              xdecomp x = [EvCoercion (mkTcSymCo (evTermCoercion x))]
@@ -1065,11 +1065,14 @@ canEqLeaf loc ev s1 s2
            _      -> panic "canEqLeaf" }
 
   | otherwise
-  = do { traceTcS "canEqLeaf" $ ppr (mkTcEqPred s1 s2)
+  = do { traceTcS "canEqLeaf" doc
        ; canEqLeafOriented loc ev cls1 s2 }
   where
     cls1 = classify s1
     cls2 = classify s2
+    doc =  vcat [ ppr ev
+                , hang (ppr s1) 2 (dcolon  <+> ppr (typeKind s1))
+                , hang (ppr s2) 2 (dcolon  <+> ppr (typeKind s2)) ]
 
 canEqLeafOriented :: CtLoc -> CtEvidence
                   -> TypeClassifier -> TcType -> TcS StopOrContinue