[commit: ghc] master: Better pretty-printing for ClsInst (d41aa76)

[git at git.haskell.org]

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

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

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

commit d41aa765327b26339526e722c2bcf14912832e72
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri May 23 07:48:06 2014 +0100

    Better pretty-printing for ClsInst


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

d41aa765327b26339526e722c2bcf14912832e72
 compiler/typecheck/Inst.lhs |  3 ++-
 compiler/types/InstEnv.lhs  | 14 ++++++--------
 2 files changed, 8 insertions(+), 9 deletions(-)

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 6ec39a2..2bcf981 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -477,7 +477,8 @@ traceDFuns :: [ClsInst] -> TcRn ()
 traceDFuns ispecs
   = traceTc "Adding instances:" (vcat (map pp ispecs))
   where
-    pp ispec = ppr (instanceDFunId ispec) <+> colon <+> ppr ispec
+    pp ispec = hang (ppr (instanceDFunId ispec) <+> colon)
+                  2 (ppr ispec)
 	-- Print the dfun name itself too
 
 funDepErr :: ClsInst -> [ClsInst] -> TcRn ()
diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs
index e7fcab0..176f189 100644
--- a/compiler/types/InstEnv.lhs
+++ b/compiler/types/InstEnv.lhs
@@ -166,15 +166,13 @@ pprInstanceHdr :: ClsInst -> SDoc
 -- Prints the ClsInst as an instance declaration
 pprInstanceHdr (ClsInst { is_flag = flag, is_dfun = dfun })
   = getPprStyle $ \ sty ->
-    let theta_to_print
-          | debugStyle sty = theta
-          | otherwise = drop (dfunNSilent dfun) theta
+    let dfun_ty = idType dfun
+        (tvs, theta, res_ty) = tcSplitSigmaTy dfun_ty
+        theta_to_print = drop (dfunNSilent dfun) theta
           -- See Note [Silent superclass arguments] in TcInstDcls
-    in ptext (sLit "instance") <+> ppr flag
-       <+> sep [pprThetaArrowTy theta_to_print, ppr res_ty]
-  where
-    (_, theta, res_ty) = tcSplitSigmaTy (idType dfun)
-       -- Print without the for-all, which the programmer doesn't write
+        ty_to_print | debugStyle sty = dfun_ty
+                    | otherwise      = mkSigmaTy tvs theta_to_print res_ty
+    in ptext (sLit "instance") <+> ppr flag <+> pprSigmaType ty_to_print
 
 pprInstances :: [ClsInst] -> SDoc
 pprInstances ispecs = vcat (map pprInstance ispecs)