swap <[]> and <{}> syntax

[ghc-hetmet.git] / compiler / types / TypeRep.lhs

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 71d1f8d..ec20914 100644 (file)
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -597,16 +597,17 @@ 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
+pprTvBndr tv 
   | isLiftedTypeKind kind = ppr_tvar tv
-  | otherwise             = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
-  where
-    kind = tyVarKind tv
+  | otherwise            = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
+            where
+              kind = tyVarKind tv
 \end{code}
 
 Note [Infix type variables]
@@ -647,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