X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=c1670f67bd61be348484370fcbf9ec87d2512033;hb=26caccd3a492556ecce7c36ce69cecc2ae7c5a75;hp=c3bd7461b9b5be938c2485e59f57b88719e87cb5;hpb=58521c72cec262496dabf5fffb057d25ab17a0f7;p=ghc-hetmet.git

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index c3bd746..c1670f6 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -304,14 +304,11 @@ funTyCon = mkFunTyCon funTyConName (mkArrowKinds [argTypeKind, openTypeKind] lif
 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
@@ -431,7 +428,13 @@ pprTypeApp tc tys = ppr_type_app TopPrec (getName tc) tys
 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) = 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