From f1fd052239528b02d386bc8d07610ec81071a537 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 9 Mar 2005 16:58:15 +0000
Subject: [PATCH] [project @ 2005-03-09 16:58:15 by simonpj] Add parser
 support for infix type-variable operators

---
 ghc/compiler/parser/Parser.y.pp |   28 +++++++++++++++++++---------
 1 file changed, 19 insertions(+), 9 deletions(-)

diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
index d143540..4fa738a 100644
--- a/ghc/compiler/parser/Parser.y.pp
+++ b/ghc/compiler/parser/Parser.y.pp
@@ -68,10 +68,10 @@ Conflicts: 34 shift/reduce (1.15)
 	  case v of
 	    (x::T -> T) -> ..	-- Rhs is ...
 
-8 for ambiguity in 'e :: a `b` c'.  Does this mean 	[States 11, 253]
+10 for ambiguity in 'e :: a `b` c'.  Does this mean 	[States 11, 253]
 	(e::a) `b` c, or 
 	(e :: (a `b` c))
-    As well as `b` we can have !, QCONSYM, and CONSYM, hence 3 cases
+    As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases
     Same duplication between states 11 and 253 as the previous case
 
 1 for ambiguity in 'let ?x ...'				[State 329]
@@ -766,7 +766,7 @@ type :: { LHsType RdrName }
 gentype :: { LHsType RdrName }
         : btype                         { $1 }
         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
-        | btype  '`' tyvar '`' gentype  { LL $ HsOpTy $1 $3 $5 }
+        | btype tyvarop  gentype  	{ LL $ HsOpTy $1 $2 $3 }
 	| btype '->' gentype		{ LL $ HsFunTy $1 $3 }
 
 btype :: { LHsType RdrName }
@@ -775,7 +775,7 @@ btype :: { LHsType RdrName }
 
 atype :: { LHsType RdrName }
 	: gtycon			{ L1 (HsTyVar (unLoc $1)) }
-	| tyvar				{ L1 (HsTyVar (unLoc $1)) }
+	| tyvarid			{ L1 (HsTyVar (unLoc $1)) }
 	| strict_mark atype		{ LL (HsBangTy (unLoc $1) $2) }
 	| '(' type ',' comma_types1 ')'	{ LL $ HsTupleTy Boxed  ($2:$4) }
 	| '(#' comma_types1 '#)'	{ LL $ HsTupleTy Unboxed $2     }
@@ -1357,10 +1357,6 @@ qtyconop :: { Located RdrName }	-- Qualified or unqualified
 	: qtyconsym			{ $1 }
 	| '`' qtycon '`'		{ LL (unLoc $2) }
 
-tyconop	:: { Located RdrName }	-- Unqualified
-	: tyconsym			{ $1 }
-	| '`' tycon '`'			{ LL (unLoc $2) }
-
 qtycon :: { Located RdrName }	-- Qualified or unqualified
 	: QCONID			{ L1 $! mkQual tcClsName (getQCONID $1) }
 	| tycon				{ $1 }
@@ -1408,13 +1404,27 @@ varid_no_unsafe :: { Located RdrName }
 	| special_id		{ L1 $! mkUnqual varName (unLoc $1) }
 	| 'forall'		{ L1 $! mkUnqual varName FSLIT("forall") }
 
-tyvar 	:: { Located RdrName }
+tyvar   :: { Located RdrName }
+tyvar   : tyvarid		{ $1 }
+	| '(' tyvarsym ')'	{ LL (unLoc $2) }
+
+tyvarop :: { Located RdrName }
+tyvarop : '`' tyvarid '`'	{ LL (unLoc $2) }
+	| tyvarsym		{ $1 }
+
+tyvarid	:: { Located RdrName }
 	: VARID			{ L1 $! mkUnqual tvName (getVARID $1) }
 	| special_id		{ L1 $! mkUnqual tvName (unLoc $1) }
 	| 'unsafe' 		{ L1 $! mkUnqual tvName FSLIT("unsafe") }
 	| 'safe' 		{ L1 $! mkUnqual tvName FSLIT("safe") }
 	| 'threadsafe' 		{ L1 $! mkUnqual tvName FSLIT("threadsafe") }
 
+tyvarsym :: { Located RdrName }
+-- Does not include "!", because that is used for strictness marks
+--	         or ".", because that separates the quantified type vars from the rest
+--		 or "*", because that's used for kinds
+tyvarsym : VARSYM		{ L1 $! mkUnqual tvName (getVARSYM $1) }
+
 -- These special_ids are treated as keywords in various places, 
 -- but as ordinary ids elsewhere.   'special_id' collects all these
 -- except 'unsafe' and 'forall' whose treatment differs depending on context
-- 
1.7.10.4