X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=ec2091497ba68a2f3d5b99d01704c0c210e3974e;hb=f9c3194e1d4f0f1c370fd059192565b1e7943bf1;hp=c12f9c89dbdf9dfcfca60d199486ec37d65d68b4;hpb=15bea1b740be3d5ee755e0e7a7b214b587ad2205;p=ghc-hetmet.git

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index c12f9c8..ec20914 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -556,9 +556,7 @@ instance Outputable name => OutputableBndr (IPName name) where
 	-- OK, here's the main printer
 
 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>")) <> (pprPredTy pred)
 ppr_type p (TyConApp tc tys)  = pprTcApp p ppr_type tc tys
@@ -594,17 +592,22 @@ ppr_forall_type p ty
     split2 ps (PredTy p `FunTy` ty) = split2 (p:ps) ty
     split2 ps ty		    = (reverse ps, ty)
 
+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)
-  where
-    kind = tyVarKind tv
+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]
@@ -645,8 +648,16 @@ pprTcApp _ pp tc [ty]
   | tc `hasKey` argTypeKindTyConKey      = ptext (sLit "??")
 
 pprTcApp p pp tc tys
+
   | isTupleTyCon tc && tyConArity tc == length tys
   = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map (pp TopPrec) tys)))
+
+  | tc `hasKey` hetMetKappaTyConKey, [ty1,ty2] <- tys
+  = pp TopPrec ty1 <> ptext (sLit "~~>") <> pp TopPrec ty2
+
+  | tc `hasKey` hetMetCodeTypeTyConKey, [ty1,ty2] <- tys
+  = ptext (sLit "<[") <> pp TopPrec ty2 <> ptext (sLit "]>@") <> pp TopPrec ty1
+
   | otherwise
   = pprTypeNameApp p pp (getName tc) tys