X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=48481e2bb561c771035fc95a46753a8a666d8254;hb=f098cfb236c17bcb3c46e39f9b1d7d8d8ca86003;hp=7b5324bf340eae9ee9b42fa860d265da460c77fa;hpb=d365fe1e7f9677715a9249b6dc86aefd2e09018e;p=ghc-hetmet.git

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 7b5324b..48481e2 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -448,11 +448,10 @@ pprType, pprParendType :: Type -> SDoc
 pprType       ty = ppr_type TopPrec   ty
 pprParendType ty = ppr_type TyConPrec ty
 
-pprTypeApp :: NamedThing a => a -> SDoc -> [Type] -> SDoc
--- The first arg is the tycon; it's used to arrange printing infix 
--- if it looks like an operator
--- Second arg is the pretty-printed tycon
-pprTypeApp tc pp_tc tys = ppr_type_app TopPrec (getName tc) pp_tc tys
+pprTypeApp :: NamedThing a => a -> [Type] -> SDoc
+-- The first arg is the tycon, or sometimes class
+-- Print infix if the tycon/class looks like an operator
+pprTypeApp tc tys = ppr_type_app TopPrec (getName tc) tys
 
 ------------------
 pprPred :: PredType -> SDoc
@@ -460,7 +459,7 @@ pprPred (ClassP cls tys) = pprClassPred cls tys
 pprPred (IParam ip ty)   = ppr ip <> dcolon <> pprType ty
 pprPred (EqPred ty1 ty2) = sep [ppr ty1, nest 2 (ptext (sLit "~")), ppr ty2]
 pprClassPred :: Class -> [Type] -> SDoc
-pprClassPred clas tys = ppr_type_app TopPrec (getName clas) (ppr clas) tys
+pprClassPred clas tys = ppr_type_app TopPrec (getName clas) tys
 
 pprTheta :: ThetaType -> SDoc
 pprTheta theta = parens (sep (punctuate comma (map pprPred theta)))
@@ -543,26 +542,23 @@ ppr_tc_app p tc tys
   | isTupleTyCon tc && tyConArity tc == length tys
   = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
   | otherwise
-  = ppr_type_app p (getName tc) (ppr_naked_tc tc) tys
+  = ppr_type_app p (getName tc) tys
 
-ppr_type_app :: Prec -> Name -> SDoc -> [Type] -> SDoc
-ppr_type_app p tc pp_tc tys
+ppr_type_app :: Prec -> Name -> [Type] -> SDoc
+-- Used for classes as well as types; that's why it's separate from ppr_tc_app
+ppr_type_app p tc tys
   | is_sym_occ		-- Print infix if possible
   , [ty1,ty2] <- tys	-- We know nothing of precedence though
   = maybeParen p FunPrec (sep [ppr_type FunPrec ty1, 
-			       pp_tc <+> ppr_type FunPrec ty2])
+			       pprInfixVar True (ppr tc) <+> ppr_type FunPrec ty2])
   | otherwise
-  = maybeParen p TyConPrec (hang paren_tc 2 (sep (map pprParendType tys)))
+  = maybeParen p TyConPrec (hang (pprPrefixVar is_sym_occ (ppr tc))
+    	       	 	       2 (sep (map pprParendType tys)))
   where
     is_sym_occ = isSymOcc (getOccName tc)
-    paren_tc | is_sym_occ = parens pp_tc
-	     | otherwise  = pp_tc
 
-ppr_tc :: TyCon -> SDoc
-ppr_tc tc = parenSymOcc (getOccName tc) (ppr_naked_tc tc)
-
-ppr_naked_tc :: TyCon -> SDoc	-- No brackets for SymOcc
-ppr_naked_tc tc 
+ppr_tc :: TyCon -> SDoc	-- No brackets for SymOcc
+ppr_tc tc 
   = pp_nt_debug <> ppr tc
   where
    pp_nt_debug | isNewTyCon tc = ifPprDebug (if isRecursiveTyCon tc