X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=889e4cef727258f9bd46de80c1b087d9f8a071c0;hp=009eddca6281abcd815386a4515deccc9c171b85;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hpb=d386e0d20c6953b7cba4d53538a1782c4aa9980d

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 009eddc..889e4ce 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -178,9 +178,9 @@ incorrect.
  'data' 	{ L _ ITdata } 
  'default' 	{ L _ ITdefault }
  'deriving' 	{ L _ ITderiving }
+ 'derived' 	{ L _ ITderived }
  'do' 		{ L _ ITdo }
  'else' 	{ L _ ITelse }
- 'for' 	        { L _ ITfor }
  'hiding' 	{ L _ IThiding }
  'if' 		{ L _ ITif }
  'import' 	{ L _ ITimport }
@@ -740,10 +740,7 @@ tycl_hdr :: { Located (LHsContext RdrName,
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
-  	: 'deriving' qtycon            'for' qtycon  {% do { p <- checkInstType (fmap HsTyVar $2)
-				                           ; checkDerivDecl (LL (DerivDecl p $4)) } }
-
-        | 'deriving' '(' inst_type ')' 'for' qtycon  {% checkDerivDecl (LL (DerivDecl $3 $6)) }
+  	: 'derived' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
 
 -----------------------------------------------------------------------------
 -- Nested declarations
@@ -971,8 +968,13 @@ ctype	:: { LHsType RdrName }
 -- errors in ctype.  The basic problem is that
 --	(Eq a, Ord a)
 -- looks so much like a tuple type.  We can't tell until we find the =>
+--
+-- We have the t1 ~ t2 form here and in gentype, to permit an individual
+-- equational constraint without parenthesis.
 context :: { LHsContext RdrName }
-	: btype 			{% checkContext $1 }
+        : btype '~'      btype  	{% checkContext
+					     (LL $ HsPredTy (HsEqualP $1 $3)) }
+	| btype 			{% checkContext $1 }
 
 type :: { LHsType RdrName }
 	: ipvar '::' gentype		{ LL (HsPredTy (HsIParam (unLoc $1) $3)) }
@@ -983,7 +985,7 @@ gentype :: { LHsType RdrName }
         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
         | btype tyvarop  gentype  	{ LL $ HsOpTy $1 $2 $3 }
  	| btype '->'     ctype		{ LL $ HsFunTy $1 $3 }
-        | btype '~'      gentype  	{ LL $ HsPredTy (HsEqualP $1 $3) }
+        | btype '~'      btype  	{ LL $ HsPredTy (HsEqualP $1 $3) }
 
 btype :: { LHsType RdrName }
 	: btype atype			{ LL $ HsAppTy $1 $2 }
@@ -1736,7 +1738,7 @@ special_id
 	: 'as'			{ L1 FSLIT("as") }
 	| 'qualified'		{ L1 FSLIT("qualified") }
 	| 'hiding'		{ L1 FSLIT("hiding") }
-        | 'for'                 { L1 FSLIT("for") }
+	| 'derived'		{ L1 FSLIT("derived") }
 	| 'export'		{ L1 FSLIT("export") }
 	| 'label'		{ L1 FSLIT("label")  }
 	| 'dynamic'		{ L1 FSLIT("dynamic") }