From: simonpj <unknown>
Date: Tue, 9 Nov 2004 12:41:18 +0000 (+0000)
Subject: [project @ 2004-11-09 12:41:18 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~1472
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=185995ebb5573136e9c2841c6525f3d0867f23b2;p=ghc-hetmet.git

[project @ 2004-11-09 12:41:18 by simonpj]
Improve pretty-printing for types
---

diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs
index 7bbbc5a..a3487a4 100644
--- a/ghc/compiler/types/TypeRep.lhs
+++ b/ghc/compiler/types/TypeRep.lhs
@@ -351,6 +351,9 @@ ppr_type p (TyConApp tc tys) = ppr_tc_app p tc tys
 ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
 			   pprType t1 <+> ppr_type TyConPrec t2
 
+ppr_type p ty@(ForAllTy _ _)       = ppr_forall_type p ty
+ppr_type p ty@(FunTy (PredTy _) _) = ppr_forall_type p ty
+
 ppr_type p (FunTy ty1 ty2)
   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
     maybeParen p FunPrec $
@@ -359,7 +362,8 @@ ppr_type p (FunTy ty1 ty2)
     ppr_fun_tail (FunTy ty1 ty2) = (arrow <+> ppr_type FunPrec ty1) : ppr_fun_tail ty2
     ppr_fun_tail other_ty        = [arrow <+> pprType other_ty]
 
-ppr_type p ty@(ForAllTy _ _)  
+ppr_forall_type :: Prec -> Type -> SDoc
+ppr_forall_type p ty
   = maybeParen p FunPrec $
     sep [pprForAll tvs, pprThetaArrow ctxt, pprType tau]
   where
@@ -398,6 +402,7 @@ ppr_tc tc
   | otherwise = ppr tc
 			       
 -------------------
+pprForAll []  = empty
 pprForAll tvs = ptext SLIT("forall") <+> sep (map pprTvBndr tvs) <> dot
 
 pprTvBndr tv | isLiftedTypeKind kind = ppr tv