X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=7fdf4ae4dffca97099c1c052e3da88943044881e;hp=8322e9d425e671fe13dd6e97c68bedac36cc2942;hb=d700bac1dabe26d2fadce661a0ba78664b86bd89;hpb=ebff59fc35239fffad714f5414e83208ccd2a458

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 8322e9d..7fdf4ae 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -455,8 +455,8 @@ 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 "=>"
@@ -485,9 +485,7 @@ pprKind = pprType
 pprParendKind = pprParendType
 
 ppr_type :: Prec -> Type -> SDoc
-ppr_type _ (TyVarTy tv)		-- Note [Infix type variables]
-  | isSymOcc (getOccName tv)  = parens (ppr tv)
-  | otherwise		      = ppr tv
+ppr_type _ (TyVarTy tv)	      = ppr_tvar tv
 ppr_type p (PredTy pred)      = maybeParen p TyConPrec $
                                 ifPprDebug (ptext (sLit "<pred>")) <> (ppr pred)
 ppr_type p (TyConApp tc tys)  = ppr_tc_app p tc tys
@@ -503,8 +501,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
@@ -567,21 +568,26 @@ ppr_tc tc
 					     else ptext (sLit "<nt>"))
 	       | otherwise     = empty
 
+ppr_tvar :: TyVar -> SDoc
+ppr_tvar tv  -- Note [Infix type variables]
+  | isSymOcc (getOccName tv)  = parens (ppr tv)
+  | otherwise		      = ppr tv
+
 -------------------
 pprForAll :: [TyVar] -> SDoc
 pprForAll []  = empty
 pprForAll tvs = ptext (sLit "forall") <+> sep (map pprTvBndr tvs) <> dot
 
 pprTvBndr :: TyVar -> SDoc
-pprTvBndr tv | isLiftedTypeKind kind = ppr tv
-	     | otherwise	     = parens (ppr tv <+> dcolon <+> pprKind kind)
+pprTvBndr tv | isLiftedTypeKind kind = ppr_tvar tv
+	     | otherwise	     = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
 	     where
 	       kind = tyVarKind tv
 \end{code}
 
 Note [Infix type variables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In Haskell 98 you can say
+With TypeOperators you can say
 
    f :: (a ~> b) -> b