X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FParseIface.y;h=30083ff093ae4bac4110d9e6118471dbd040bde2;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hp=bae7fda7ffb6fc5bc0d345b1c97bfac2d59ee499;hpb=3990d44447b6c38a2effd68beb50da459dfd19fc;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index bae7fda..30083ff 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -3,7 +3,7 @@
 
 module ParseIface ( parseIface ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import ParseUtils
 
@@ -12,14 +12,14 @@ import RdrHsSyn		-- oodles of synonyms
 import HsPragmas	( noGenPragmas )
 
 import Bag		( emptyBag, unitBag, snocBag )
-import FiniteMap	( emptyFM, unitFM, addToFM, plusFM, bagToFM )
-import Name		( ExportFlag(..), mkTupNameStr,
+import FiniteMap	( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
+import Name		( ExportFlag(..), mkTupNameStr, preludeQual,
 			  RdrName(..){-instance Outputable:ToDo:rm-}
 			)
-import Outputable	-- ToDo:rm
-import PprStyle		( PprStyle(..) ) -- ToDo: rm debugging
+--import Outputable	-- ToDo:rm
+--import PprStyle		( PprStyle(..) ) -- ToDo: rm debugging
 import SrcLoc		( mkIfaceSrcLoc )
-import Util		( panic, pprPanic{-ToDo:rm-} )
+import Util		( panic{-, pprPanic ToDo:rm-} )
 
 -----------------------------------------------------------------
 
@@ -43,9 +43,9 @@ parseIface = parseIToks . lexIface
 	DECLARATIONS_PART   { ITdeclarations }
 	PRAGMAS_PART	    { ITpragmas }
 	BANG		    { ITbang }
-	BQUOTE		    { ITbquote }
 	CBRACK		    { ITcbrack }
 	CCURLY		    { ITccurly }
+	DCCURLY		    { ITdccurly }
 	CLASS		    { ITclass }
 	COMMA		    { ITcomma }
 	CPAREN		    { ITcparen }
@@ -54,6 +54,7 @@ parseIface = parseIToks . lexIface
 	DCOLON		    { ITdcolon }
 	DOTDOT		    { ITdotdot }
 	EQUAL		    { ITequal }
+	FORALL		    { ITforall }
 	INFIX		    { ITinfix }
 	INFIXL		    { ITinfixl }
 	INFIXR		    { ITinfixr }
@@ -61,6 +62,7 @@ parseIface = parseIToks . lexIface
 	NEWTYPE		    { ITnewtype }
 	OBRACK		    { ITobrack }
 	OCURLY		    { ITocurly }
+	DOCURLY		    { ITdocurly }
 	OPAREN		    { IToparen }
 	RARROW		    { ITrarrow }
 	SEMI		    { ITsemi }
@@ -119,24 +121,25 @@ module_stuff_pair   :  CONID INTEGER DCOLON name_version_pairs SEMI
 name_version_pairs  ::	{ Bag (FAST_STRING, Int) }
 name_version_pairs  :  name_version_pair
 			{ unitBag $1 }
-		    |  name_version_pairs COMMA name_version_pair
-			{ $1 `snocBag` $3 }
+		    |  name_version_pairs name_version_pair
+			{ $1 `snocBag` $2 }
 
 name_version_pair   ::	{ (FAST_STRING, Int) }
-name_version_pair   :  iname INTEGER
+name_version_pair   :  name INTEGER
 			{ ($1, fromInteger $2)
 --------------------------------------------------------------------------
 			}
 
 exports_part	:: { ExportsMap }
 exports_part	:  EXPORTS_PART export_items { bagToFM $2 }
+		|			     { emptyFM }
 
-export_items	:: { Bag (FAST_STRING, (RdrName, ExportFlag)) }
+export_items	:: { Bag (FAST_STRING, (OrigName, ExportFlag)) }
 export_items	:  export_item		    { unitBag $1 }
 		|  export_items export_item { $1 `snocBag` $2 }
 
-export_item	:: { (FAST_STRING, (RdrName, ExportFlag)) }
-export_item	:  qiname maybe_dotdot	    { (de_qual $1, ($1, $2)) }
+export_item	:: { (FAST_STRING, (OrigName, ExportFlag)) }
+export_item	:  CONID name maybe_dotdot { ($2, (OrigName $1 $2, $3)) }
 
 maybe_dotdot	:: { ExportFlag }
 maybe_dotdot	:  DOTDOT { ExportAll }
@@ -163,14 +166,15 @@ fixes		:  fix  	{ case $1 of (k,v) -> unitFM k v }
 		|  fixes fix	{ case $2 of (k,v) -> addToFM $1 k v }
 
 fix		:: { (FAST_STRING, RdrNameFixityDecl) }
-fix		:  INFIXL INTEGER qop SEMI { (de_qual $3, InfixL $3 (fromInteger $2)) }
-		|  INFIXR INTEGER qop SEMI { (de_qual $3, InfixR $3 (fromInteger $2)) }
-		|  INFIX  INTEGER qop SEMI { (de_qual $3, InfixN $3 (fromInteger $2))
+fix		:  INFIXL INTEGER qname SEMI { (de_qual $3, InfixL $3 (fromInteger $2)) }
+		|  INFIXR INTEGER qname SEMI { (de_qual $3, InfixR $3 (fromInteger $2)) }
+		|  INFIX  INTEGER qname SEMI { (de_qual $3, InfixN $3 (fromInteger $2))
 --------------------------------------------------------------------------
 				      }
 
 decls_part	:: { (LocalTyDefsMap, LocalValDefsMap) }
 decls_part	: DECLARATIONS_PART topdecls { $2 }
+		|			     { (emptyFM, emptyFM) }
 
 topdecls	:: { (LocalTyDefsMap, LocalValDefsMap) }
 topdecls	:  topdecl	    { $1 }
@@ -215,8 +219,7 @@ decl		:: { (FAST_STRING, RdrNameSig) }
 decl		:  var DCOLON ctype SEMI { (de_qual $1, Sig $1 $3 noGenPragmas mkIfaceSrcLoc) }
 
 context		:: { RdrNameContext }
-context		:  OPAREN context_list CPAREN	{ reverse $2 }
-		|  class			{ [$1] }
+context		:  DOCURLY context_list DCCURLY	{ reverse $2 }
 
 context_list	:: { RdrNameContext{-reversed-} }
 context_list	:  class			{ [$1] }
@@ -226,8 +229,9 @@ class		:: { (RdrName, RdrName) }
 class		:  gtycon VARID			{ ($1, Unqual $2) }
 
 ctype		:: { RdrNamePolyType }
-ctype		: type DARROW type  { HsPreForAllTy (type2context $1) $3 }
-		| type		    { HsPreForAllTy []		      $1 }
+ctype		: FORALL OBRACK tyvars CBRACK context DARROW type  { HsForAllTy (map Unqual $3) $5 $7 }
+		| FORALL OBRACK tyvars CBRACK type		   { HsForAllTy (map Unqual $3) [] $5 }
+		| type	{ HsForAllTy [] [] $1 }
 
 type		:: { RdrNameMonoType }
 type		:  btype		{ $1 }
@@ -246,11 +250,11 @@ btype		:  gtyconapp		{ case $1 of (tc, tys) -> MonoTyApp tc tys }
 					  case ty1 of {
 					    MonoTyVar tv    -> MonoTyApp tv tys;
 					    MonoTyApp tc ts -> MonoTyApp tc (ts++tys);
-					    MonoFunTy t1 t2 -> MonoTyApp (Unqual SLIT("->")) (t1:t2:tys);
-					    MonoListTy ty   -> MonoTyApp (Unqual SLIT("[]")) (ty:tys);
-					    MonoTupleTy ts  -> MonoTyApp (Unqual (mkTupNameStr (length ts)))
+					    MonoFunTy t1 t2 -> MonoTyApp (preludeQual SLIT("->")) (t1:t2:tys);
+					    MonoListTy ty   -> MonoTyApp (preludeQual SLIT("[]")) (ty:tys);
+					    MonoTupleTy ts  -> MonoTyApp (preludeQual (mkTupNameStr (length ts)))
 									 (ts++tys);
-					    _		    -> pprPanic "test:" (ppr PprDebug $1)
+--					    _		    -> pprPanic "test:" (ppr PprDebug $1)
 					  }}
 					}
 
@@ -278,11 +282,10 @@ ntycon		:  VARID			  { MonoTyVar (Unqual $1) }
 
 gtycon		:: { RdrName }
 gtycon		:  QCONID		{ $1 }
-		|  CONID		{ Unqual $1 }
-		|  OPAREN RARROW CPAREN	{ Unqual SLIT("->") }
-		|  OBRACK CBRACK	{ Unqual SLIT("[]") }
-		|  OPAREN CPAREN	{ Unqual SLIT("()") }
-		|  OPAREN commas CPAREN	{ Unqual (mkTupNameStr $2) }
+		|  OPAREN RARROW CPAREN	{ preludeQual SLIT("->") }
+		|  OBRACK CBRACK	{ preludeQual SLIT("[]") }
+		|  OPAREN CPAREN	{ preludeQual SLIT("()") }
+		|  OPAREN commas CPAREN	{ preludeQual (mkTupNameStr $2) }
 
 commas		:: { Int }
 commas		:  COMMA		{ 2{-1 comma => arity 2-} }
@@ -303,10 +306,8 @@ constrs		:  constr		{ [$1] }
 constr		:: { (RdrName, RdrNameConDecl) }
 constr		:  btyconapp
 		   { case $1 of (con, tys) -> (con, ConDecl con tys mkIfaceSrcLoc) }
-		|  OPAREN QCONSYM CPAREN	 { ($2, ConDecl $2 [] mkIfaceSrcLoc) }
-		|  OPAREN QCONSYM CPAREN batypes { ($2, ConDecl $2 $4 mkIfaceSrcLoc) }
-		|  OPAREN CONSYM CPAREN		 { (Unqual $2, ConDecl (Unqual $2) [] mkIfaceSrcLoc) }
-		|  OPAREN CONSYM CPAREN batypes  { (Unqual $2, ConDecl (Unqual $2) $4 mkIfaceSrcLoc) }
+		|  QCONSYM	   { ($1, ConDecl $1 [] mkIfaceSrcLoc) }
+		|  QCONSYM batypes { ($1, ConDecl $1 $2 mkIfaceSrcLoc) }
 		|  gtycon OCURLY fields CCURLY
 		   { ($1, RecConDecl $1 $3 mkIfaceSrcLoc) }
 
@@ -314,13 +315,9 @@ btyconapp	:: { (RdrName, [RdrNameBangType]) }
 btyconapp	:  gtycon			{ ($1, []) }
 		|  btyconapp batype		{ case $1 of (tc,tys) -> (tc, tys ++ [$2]) }
 
-bbtype		:: { RdrNameBangType }
-bbtype		:  btype			{ Unbanged (HsPreForAllTy [] $1) }
-		|  BANG atype			{ Banged   (HsPreForAllTy [] $2) }
-
 batype		:: { RdrNameBangType }
-batype		:  atype			{ Unbanged (HsPreForAllTy [] $1) }
-		|  BANG atype			{ Banged   (HsPreForAllTy [] $2) }
+batype		:  atype			{ Unbanged (HsForAllTy [{-ToDo:tvs-}] [] $1) }
+		|  BANG atype			{ Banged   (HsForAllTy [{-ToDo:tvs-}] [] $2) }
 
 batypes		:: { [RdrNameBangType] }
 batypes		:  batype			{ [$1] }
@@ -331,43 +328,31 @@ fields		: field				{ [$1] }
 		| fields COMMA field		{ $1 ++ [$3] }
 
 field		:: { ([RdrName], RdrNameBangType) }
-field		:  var DCOLON type	    { ([$1], Unbanged (HsPreForAllTy [] $3)) }
-		|  var DCOLON BANG atype    { ([$1], Banged   (HsPreForAllTy [] $4)) }
+field		:  var DCOLON type	    { ([$1], Unbanged (HsForAllTy [{-ToDo:tvs-}] [] $3)) }
+		|  var DCOLON BANG atype    { ([$1], Banged   (HsForAllTy [{-ToDo:tvs-}] [] $4)) }
 
 constr1		:: { (RdrName, RdrNameMonoType) }
 constr1		:  gtycon atype	{ ($1, $2) }
 
 var		:: { RdrName }
-var		:  QVARID		 { $1 }
-		|  OPAREN QVARSYM CPAREN { $2 }
-		|  VARID		 { Unqual $1 }
-		|  OPAREN VARSYM CPAREN  { Unqual $2 }
-
-op		:: { FAST_STRING }
-op		:  BQUOTE VARID BQUOTE	{ $2 }
-		|  BQUOTE CONID BQUOTE	{ $2 }
-		|  VARSYM		{ $1 }
-		|  CONSYM		{ $1 }
+var		:  QVARID		{ $1 }
+		|  QVARSYM		{ $1 }
 
-qop		:: { RdrName }
-qop		:  BQUOTE QVARID BQUOTE	{ $2 }
-		|  BQUOTE QCONID BQUOTE	{ $2 }
+qname		:: { RdrName }
+qname		:  QVARID		{ $1 }
+		|  QCONID		{ $1 }
 		|  QVARSYM		{ $1 }
 		|  QCONSYM		{ $1 }
-		|  op			{ Unqual $1 }
 
-iname		:: { FAST_STRING }
-iname		:  VARID		{ $1 }
+name		:: { FAST_STRING }
+name		:  VARID		{ $1 }
 		|  CONID		{ $1 }
-		|  OPAREN VARSYM CPAREN	{ $2 }
-		|  OPAREN CONSYM CPAREN	{ $2 }
-
-qiname		:: { RdrName }
-qiname		:  QVARID		    { $1 }
-		|  QCONID		    { $1 }
-		|  OPAREN QVARSYM CPAREN    { $2 }
-		|  OPAREN QCONSYM CPAREN    { $2 }
-		|  iname		    { Unqual $1 }
+		|  VARSYM		{ $1 }
+		|  BANG  		{ SLIT("!"){-sigh, double-sigh-} }
+		|  CONSYM		{ $1 }  
+		|  OBRACK CBRACK	{ SLIT("[]") }
+		|  OPAREN CPAREN	{ SLIT("()") }
+		|  OPAREN commas CPAREN	{ mkTupNameStr $2 }
 
 instances_part	:: { Bag RdrIfaceInst }
 instances_part	:  INSTANCES_PART instdecls { $2 }
@@ -378,13 +363,14 @@ instdecls	:  instd		    { unitBag $1 }
 		|  instdecls instd	    { $1 `snocBag` $2 }
 
 instd		:: { RdrIfaceInst }
-instd		:  INSTANCE context DARROW gtycon restrict_inst	SEMI { mk_inst $2 $4 $5 }
-		|  INSTANCE		   gtycon general_inst	SEMI { mk_inst [] $2 $3 }
+instd		:  INSTANCE FORALL OBRACK tyvars CBRACK context DARROW gtycon restrict_inst SEMI { mk_inst (map Unqual $4) $6 $8 $9 }
+		|  INSTANCE FORALL OBRACK tyvars CBRACK		       gtycon general_inst  SEMI { mk_inst (map Unqual $4) [] $6 $7 }
+		|  INSTANCE gtycon general_inst	SEMI { mk_inst [] [] $2 $3 }
 
 restrict_inst	:: { RdrNameMonoType }
 restrict_inst	:  gtycon				{ MonoTyApp $1 [] }
-		|  OPAREN gtyconvars CPAREN		{ case $2 of (tc,tvs) -> MonoTyApp tc (map en_mono tvs) }
-		|  OPAREN VARID COMMA tyvar_list CPAREN	{ MonoTupleTy (map en_mono ($2:$4)) }
+		|  OPAREN gtyconvars CPAREN		{ case $2 of (tc,tvs) -> MonoTyApp tc (map en_mono (reverse tvs)) }
+		|  OPAREN VARID COMMA tyvars CPAREN	{ MonoTupleTy (map en_mono ($2:$4)) }
 		|  OBRACK VARID CBRACK			{ MonoListTy (en_mono $2) }
 		|  OPAREN VARID RARROW VARID CPAREN	{ MonoFunTy (en_mono $2) (en_mono $4) }
 
@@ -395,9 +381,9 @@ general_inst	:  gtycon				{ MonoTyApp $1 [] }
 		|  OBRACK type CBRACK			{ MonoListTy $2 }
 		|  OPAREN btype RARROW type CPAREN	{ MonoFunTy $2 $4 }
 
-tyvar_list	:: { [FAST_STRING] }
-tyvar_list	:  VARID		    { [$1] }
-		|  tyvar_list COMMA VARID   { $1 ++ [$3]
+tyvars		:: { [FAST_STRING] }
+tyvars		:  VARID		    { [$1] }
+		|  tyvars COMMA VARID   { $1 ++ [$3]
 --------------------------------------------------------------------------
 					    }