[commit: ghc] master: More refinements to debugPprType (ab2d3d5)

[git at git.haskell.org]

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

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

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

commit ab2d3d5db6e2a16cccdfdfc89c9b6f30834fa335
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sat Sep 2 18:10:49 2017 +0100

    More refinements to debugPprType


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

ab2d3d5db6e2a16cccdfdfc89c9b6f30834fa335
 compiler/types/TyCoRep.hs | 21 +++++++++------------
 1 file changed, 9 insertions(+), 12 deletions(-)

diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 80681e7..d58536b 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -2435,7 +2435,11 @@ pprType       = pprPrecType TopPrec
 pprParendType = pprPrecType TyConPrec
 
 pprPrecType :: TyPrec -> Type -> SDoc
-pprPrecType prec ty = getPprStyle $ \sty -> pprPrecIfaceType prec (tidyToIfaceTypeSty ty sty)
+pprPrecType prec ty
+  = getPprStyle $ \sty ->
+    if debugStyle sty           -- Use pprDebugType when in
+    then debug_ppr_ty prec ty   -- when in debug-style
+    else pprPrecIfaceType prec (tidyToIfaceTypeSty ty sty)
 
 pprTyLit :: TyLit -> SDoc
 pprTyLit = pprIfaceTyLit . toIfaceTyLit
@@ -2561,9 +2565,7 @@ debug_ppr_ty _ (LitTy l)
   = ppr l
 
 debug_ppr_ty _ (TyVarTy tv)
-  = ifPprDebug (parens (ppr tv <+> dcolon
-                        <+> (debugPprType (tyVarKind tv))))
-               (ppr tv)
+  = ppr tv  -- With -dppr-debug we get (tv :: kind)
 
 debug_ppr_ty prec (FunTy arg res)
   = maybeParen prec FunPrec $
@@ -2589,7 +2591,9 @@ debug_ppr_ty _ (CoercionTy co)
 debug_ppr_ty prec ty@(ForAllTy {})
   | (tvs, body) <- split ty
   = maybeParen prec FunPrec $
-    hang (text "forall" <+> fsep (map pp_bndr tvs) <> dot)
+    hang (text "forall" <+> fsep (map ppr tvs) <> dot)
+         -- The (map ppr tvs) will print kind-annotated
+         -- tvs, because we are (usually) in debug-style
        2 (ppr body)
   where
     split ty | ForAllTy tv ty' <- ty
@@ -2598,13 +2602,6 @@ debug_ppr_ty prec ty@(ForAllTy {})
              | otherwise
              = ([], ty)
 
-    pp_bndr, pp_with_kind :: TyVarBinder -> SDoc
-    pp_bndr tv = ifPprDebug (ppr tv) (pp_with_kind tv)
-
-    pp_with_kind tv
-     = parens (ppr tv <+> dcolon
-               <+> ppr (tyVarKind (binderVar tv)))
-
 {-
 Note [When to print foralls]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~