From: simonpj <unknown>
Date: Fri, 14 Jun 2002 16:19:04 +0000 (+0000)
Subject: [project @ 2002-06-14 16:19:04 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~1964
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6dcb16bf86abec77c7f681480e679a7ab6065a40;p=ghc-hetmet.git

[project @ 2002-06-14 16:19:04 by simonpj]
Another HsParTy wibble; cures rn018 failure
---

diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index bfacdcd..dddcc8b 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -172,13 +172,18 @@ hsTupParens (HsTupCon _ b _) p = tupleParens b p
 --
 -- A valid type must have one for-all at the top of the type, or of the fn arg types
 
-mkHsForAllTy (Just []) [] ty = ty	-- Explicit for-all with no tyvars
-mkHsForAllTy mtvs1     [] (HsForAllTy mtvs2 ctxt ty) = mkHsForAllTy (mtvs1 `plus` mtvs2) ctxt ty
-						     where
-						       mtvs1       `plus` Nothing     = mtvs1
-						       Nothing     `plus` mtvs2       = mtvs2 
-						       (Just tvs1) `plus` (Just tvs2) = Just (tvs1 ++ tvs2)
-mkHsForAllTy tvs ctxt ty = HsForAllTy tvs ctxt ty
+mkHsForAllTy mtvs []   ty = mk_forall_ty mtvs ty
+mkHsForAllTy mtvs ctxt ty = HsForAllTy mtvs ctxt ty
+
+-- mk_forall_ty makes a pure for-all type (no context)
+mk_forall_ty (Just []) ty 			  = ty	-- Explicit for-all with no tyvars
+mk_forall_ty mtvs1     (HsParTy ty)		  = mk_forall_ty mtvs1 ty
+mk_forall_ty mtvs1     (HsForAllTy mtvs2 ctxt ty) = mkHsForAllTy (mtvs1 `plus` mtvs2) ctxt ty
+mk_forall_ty mtvs1     ty			  = HsForAllTy mtvs1 [] ty
+
+mtvs1       `plus` Nothing     = mtvs1
+Nothing     `plus` mtvs2       = mtvs2 
+(Just tvs1) `plus` (Just tvs2) = Just (tvs1 ++ tvs2)
 
 mkHsDictTy cls tys = HsPredTy (HsClassP cls tys)
 mkHsIParamTy v ty  = HsPredTy (HsIParam v ty)
@@ -306,7 +311,7 @@ ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)
 	p2 = ppr_mono_ty pREC_TOP ty2
     in
     maybeParen (ctxt_prec >= pREC_FUN)
-	       (sep [p1, (<>) (ptext SLIT("-> ")) p2])
+	       (sep [p1, ptext SLIT("->") <+> p2])
 
 ppr_mono_ty ctxt_prec (HsTupleTy con tys) = hsTupParens con (interpp'SP tys)
 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_ty pREC_TOP ty <+> dcolon <+> pprKind kind)