X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypes%2FTypeRep.lhs;h=a7cfd5a10a961c3f4df5ae4a0630cdc5bc00e22e;hb=16b9e80dc14db24509f051f294b5b51943285090;hp=aa1f941bc00f21b96ea59a6a5b46cd2f4d2dfe7e;hpb=34c8d0312071f7d0f4d221a997d3408c653ef9e5;p=ghc-hetmet.git

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index aa1f941..a7cfd5a 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -25,7 +25,7 @@ module TypeRep (
 
 	-- Kinds
 	liftedTypeKind, unliftedTypeKind, openTypeKind,
-        argTypeKind, ubxTupleKind,
+        argTypeKind, ubxTupleKind, ecKind,
 	isLiftedTypeKindCon, isLiftedTypeKind,
 	mkArrowKind, mkArrowKinds, isCoercionKind,
   	coVarPred,
@@ -343,13 +343,16 @@ kindTyConType :: TyCon -> Type
 kindTyConType kind = TyConApp kind []
 
 -- | See "Type#kind_subtyping" for details of the distinction between these 'Kind's
-liftedTypeKind, unliftedTypeKind, openTypeKind, argTypeKind, ubxTupleKind :: Kind
+liftedTypeKind, unliftedTypeKind, openTypeKind, argTypeKind, ubxTupleKind, ecKind :: Kind
 
 liftedTypeKind   = kindTyConType liftedTypeKindTyCon
 unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
 openTypeKind     = kindTyConType openTypeKindTyCon
 argTypeKind      = kindTyConType argTypeKindTyCon
 ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
+ecKind           = liftedTypeKind `mkArrowKind` (liftedTypeKind `mkArrowKind` liftedTypeKind)
+-- NOTE: if you change ecKind, you must also change the explicit kind signatures
+-- on hetmet_{brak,esc,csp} in GHC.Hetmet.CodeTypes
 
 -- | Given two kinds @k1@ and @k2@, creates the 'Kind' @k1 -> k2@
 mkArrowKind :: Kind -> Kind -> Kind
@@ -485,9 +488,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 "<pred>")) <> (ppr pred)
 ppr_type p (TyConApp tc tys)  = ppr_tc_app p tc tys
@@ -572,14 +573,19 @@ ppr_tc tc
 					     else ptext (sLit "<nt>"))
 	       | 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}