-- Pretty-printing
pprType, pprParendType, pprTypeApp,
pprTyThing, pprTyThingCategory,
- pprPred, pprTheta, pprForAll, pprThetaArrow, pprClassPred,
+ pprPred, pprEqPred, pprTheta, pprForAll, pprThetaArrow, pprClassPred,
-- Kinds
liftedTypeKind, unliftedTypeKind, openTypeKind,
-- friends:
import Var
import Name
-import OccName
import BasicTypes
import TyCon
import Class
tySuperKindTyCon = mkSuperKindTyCon tySuperKindTyConName
coSuperKindTyCon = mkSuperKindTyCon coSuperKindTyConName
-liftedTypeKindTyCon = mkKindTyCon liftedTypeKindTyConName
-openTypeKindTyCon = mkKindTyCon openTypeKindTyConName
-unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName
-ubxTupleKindTyCon = mkKindTyCon ubxTupleKindTyConName
-argTypeKindTyCon = mkKindTyCon argTypeKindTyConName
-
-mkKindTyCon :: Name -> TyCon
-mkKindTyCon name = mkVoidPrimTyCon name tySuperKind 0
+liftedTypeKindTyCon = mkKindTyCon liftedTypeKindTyConName tySuperKind
+openTypeKindTyCon = mkKindTyCon openTypeKindTyConName tySuperKind
+unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName tySuperKind
+ubxTupleKindTyCon = mkKindTyCon ubxTupleKindTyConName tySuperKind
+argTypeKindTyCon = mkKindTyCon argTypeKindTyConName tySuperKind
--------------------------
-- ... and now their names
pprPred :: PredType -> SDoc
pprPred (ClassP cls tys) = pprClassPred cls tys
pprPred (IParam ip ty) = ppr ip <> dcolon <> pprType ty
-pprPred (EqPred ty1 ty2) = sep [ppr ty1, nest 2 (ptext (sLit "~")), ppr ty2]
+pprPred (EqPred ty1 ty2) = pprEqPred (ty1,ty2)
+
+pprEqPred :: (Type,Type) -> SDoc
+pprEqPred (ty1,ty2) = sep [ ppr_type FunPrec ty1
+ , nest 2 (ptext (sLit "~"))
+ , ppr_type FunPrec ty2]
+ -- Precedence looks like (->) so that we get
+ -- Maybe a ~ Bool
+ -- (a->a) ~ Bool
+ -- Note parens on the latter!
+
pprClassPred :: Class -> [Type] -> SDoc
pprClassPred clas tys = ppr_type_app TopPrec (getName clas) tys
ppr_type _ (TyVarTy tv) -- Note [Infix type variables]
| isSymOcc (getOccName tv) = parens (ppr tv)
| otherwise = ppr tv
-ppr_type _ (PredTy pred) = ifPprDebug (ptext (sLit "<pred>")) <> (ppr pred)
+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
ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $