From 9dd2916cc999ac9af047a8757878df1051948b5d Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Mon, 7 Jun 1999 14:58:40 +0000
Subject: [PATCH] [project @ 1999-06-07 14:58:40 by simonmar] Existential
 contexts on datatype declarations.

---
 ghc/compiler/parser/Parser.y     |   34 ++++++++++++++++++++--------------
 ghc/compiler/parser/RdrHsSyn.lhs |    2 ++
 2 files changed, 22 insertions(+), 14 deletions(-)

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index caa3a0d..4d24d4c 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.5 1999/06/03 14:44:23 simonmar Exp $
+$Id: Parser.y,v 1.6 1999/06/07 14:58:40 simonmar Exp $
 
 Haskell grammar.
 
@@ -501,12 +501,10 @@ inst_type :: { RdrNameHsType }
 	: ctype				{% checkInstType $1 }
 
 ctype	:: { RdrNameHsType }
-	: 'forall' tyvars '.' btype '=>' type
-					{% checkContext $4 `thenP` \c ->
-					   returnP (HsForAllTy (Just $2) c $6) }
+	: 'forall' tyvars '.' context type
+					{ HsForAllTy (Just $2) $4 $5 }
 	| 'forall' tyvars '.' type	{ HsForAllTy (Just $2) [] $4 }
-	| btype '=>' type		{% checkContext $1 `thenP` \c ->
-					   returnP (HsForAllTy Nothing c $3) }
+	| context type			{ HsForAllTy Nothing   $1 $2 }
 	| type				{ $1 }
 
 types0  :: { [RdrNameHsType] }
@@ -531,15 +529,23 @@ constrs :: { [RdrNameConDecl] }
 	: constrs '|' constr		{ $3 : $1 }
 	| constr			{ [$1] }
 
-{- ToDo: existential stuff -}
-
 constr :: { RdrNameConDecl }
-	: srcloc scontype   
-		{ ConDecl (fst $2) [] [] (VanillaCon (snd $2)) $1 }
-	| srcloc sbtype conop sbtype	
-		{ ConDecl $3 [] [] (InfixCon $2 $4) $1 }
-	| srcloc con '{' fielddecls '}' 
-		{ ConDecl $2 [] [] (RecCon (reverse $4)) $1 }
+	: srcloc forall context constr_stuff
+		{ ConDecl (fst $4) $2 $3 (snd $4) $1 }
+	| srcloc forall constr_stuff
+		{ ConDecl (fst $3) $2 [] (snd $3) $1 }
+
+forall :: { [RdrNameHsTyVar] }
+	: 'forall' tyvars '.'		{ $2 }
+	| {- empty -}			{ [] }
+
+context :: { RdrNameContext }
+	: btype '=>'			{% checkContext $1 }
+
+constr_stuff :: { (RdrName, RdrNameConDetails) }
+	: scontype   		 	{ (fst $1, VanillaCon (snd $1)) }
+	| sbtype conop sbtype		{ ($2, InfixCon $1 $3) }
+	| con '{' fielddecls '}' 	{ ($1, RecCon (reverse $3)) }
 
 newconstr :: { RdrNameConDecl }
 	: srcloc conid atype	{ ConDecl $2 [] [] (NewCon $3 Nothing) $1 }
diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 9fc0a2b..d063e59 100644
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -12,6 +12,7 @@ module RdrHsSyn (
 	RdrNameBangType,
 	RdrNameClassOpSig,
 	RdrNameConDecl,
+	RdrNameConDetails,
 	RdrNameContext,
 	RdrNameSpecDataSig,
 	RdrNameDefaultDecl,
@@ -84,6 +85,7 @@ type RdrNameArithSeqInfo	= ArithSeqInfo		RdrName RdrNamePat
 type RdrNameBangType		= BangType		RdrName
 type RdrNameClassOpSig		= Sig			RdrName
 type RdrNameConDecl		= ConDecl		RdrName
+type RdrNameConDetails		= ConDetails		RdrName
 type RdrNameContext		= Context 		RdrName
 type RdrNameHsDecl		= HsDecl		RdrName RdrNamePat
 type RdrNameSpecDataSig		= SpecDataSig		RdrName
-- 
1.7.10.4