X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=1be55d76a5048edc5b2693621d50050ef062b8a2;hp=85514091a4bcc06d38ae5c59c044292feea851c4;hb=cf5905ea24904cf73a041fd7535e8723a668cb9a;hpb=46809fa91667e952afe016e4cd704b21274241b4 diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs index 8551409..1be55d7 100644 --- a/compiler/types/TypeRep.lhs +++ b/compiler/types/TypeRep.lhs @@ -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 "")) <> (ppr pred) ppr_type p (TyConApp tc tys) = ppr_tc_app p tc tys @@ -543,6 +541,8 @@ ppr_tc_app _ tc [ty] | tc `hasKey` argTypeKindTyConKey = ptext (sLit "??") ppr_tc_app p tc tys + | [ecvar,ty] <- tys, tc `hasKey` hetMetCodeTypeTyConKey + = ptext (sLit "<[") <> pprType ty <> ptext (sLit "]>@") <> ppr ecvar | isTupleTyCon tc && tyConArity tc == length tys = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys))) | otherwise @@ -570,14 +570,19 @@ ppr_tc tc else ptext (sLit "")) | 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}