X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=e80bd4d8a6d8b832732a5b9938a72aed5ba2bacd;hb=ced4c13ea3577e01556a2f76c2cc458c0be6c83c;hp=74e0bdf37550f4c5a62f78a6bef0a9f6db64d5ce;hpb=9c83ea50dcfb5c5ada888cf956560df641afb130;p=ghc-hetmet.git

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 74e0bdf..e80bd4d 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -449,14 +449,14 @@ pprClassPred :: Class -> [Type] -> SDoc
 pprClassPred clas tys = ppr_type_app TopPrec (getName clas) tys
 
 pprTheta :: ThetaType -> SDoc
-pprTheta [pred] = pprPred pred
+-- pprTheta [pred] = pprPred pred	 -- I'm in two minds about this
 pprTheta theta  = parens (sep (punctuate comma (map pprPred theta)))
 
 pprThetaArrow :: ThetaType -> SDoc
 pprThetaArrow []     = empty
 pprThetaArrow [pred] 
-  | noParenPred pred = pprPred pred <+> ptext (sLit "=>")
-pprThetaArrow preds  = parens (sep (punctuate comma (map pprPred preds))) <+> ptext (sLit "=>")
+  | noParenPred pred = pprPred pred <+> darrow
+pprThetaArrow preds  = parens (sep (punctuate comma (map pprPred preds))) <+> darrow
 
 noParenPred :: PredType -> Bool
 -- A predicate that can appear without parens before a "=>"
@@ -503,8 +503,11 @@ ppr_type p (FunTy ty1 ty2)
     maybeParen p FunPrec $
     sep (ppr_type FunPrec ty1 : ppr_fun_tail ty2)
   where
-    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_fun_tail (FunTy ty1 ty2) 
+      | not (is_pred ty1) = (arrow <+> ppr_type FunPrec ty1) : ppr_fun_tail ty2
+    ppr_fun_tail other_ty = [arrow <+> pprType other_ty]
+    is_pred (PredTy {}) = True
+    is_pred _           = False
 
 ppr_forall_type :: Prec -> Type -> SDoc
 ppr_forall_type p ty