X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsTypes.lhs;h=c64dfd8301252294dc13dc1ea9159e7a1317625a;hp=75e6c23186c4a21cde73ec108c3b2ef2a5ad9956;hb=9241ac84d10f7e6b23841da2c0765275072ad7c1;hpb=f22c873e99d5b371a03d249febb89195a4fda2fc

diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index 75e6c23..c64dfd8 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -152,6 +152,9 @@ data HsType name
   | HsFunTy		(LHsType name)   -- function type
 			(LHsType name)
 
+  | HsKappaTy		(LHsType name)   -- first-order function type
+			(LHsType name)
+
   | HsListTy		(LHsType name)	-- Element type
 
   | HsPArrTy		(LHsType name)	-- Elem. type of parallel array: [:t:]
@@ -453,7 +456,8 @@ ppr_mono_ty _    (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
 ppr_mono_ty _    (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
 ppr_mono_ty _    (HsListTy ty)	     = brackets (ppr_mono_lty pREC_TOP ty)
 ppr_mono_ty _    (HsPArrTy ty)	     = pabrackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty _    (HsModalBoxType ecn ty) = ppr_modalBoxType (ppr ecn) (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty prec (HsKappaTy ty1 ty2) = ppr_kappa_ty prec ty1 ty2
+ppr_mono_ty _    (HsModalBoxType  ecn ty) = ppr_modalBoxType  (ppr ecn) (ppr_mono_lty pREC_TOP ty)
 ppr_mono_ty _    (HsPredTy pred)     = ppr pred
 ppr_mono_ty _    (HsSpliceTy s _ _)  = pprSplice s
 ppr_mono_ty _    (HsCoreTy ty)       = ppr ty
@@ -487,6 +491,14 @@ ppr_fun_ty ctxt_prec ty1 ty2
     maybeParen ctxt_prec pREC_FUN $
     sep [p1, ptext (sLit "->") <+> p2]
 
+ppr_kappa_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
+ppr_kappa_ty ctxt_prec ty1 ty2
+  = let p1 = ppr_mono_lty pREC_FUN ty1
+	p2 = ppr_mono_lty pREC_TOP ty2
+    in
+    maybeParen ctxt_prec pREC_FUN $
+    sep [p1, ptext (sLit "~~>") <+> p2]
+
 --------------------------
 pabrackets :: SDoc -> SDoc
 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")