From: simonmar <unknown>
Date: Thu, 14 Oct 1999 13:33:19 +0000 (+0000)
Subject: [project @ 1999-10-14 13:33:19 by simonmar]
X-Git-Tag: Approximately_9120_patches~5702
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=517e0b56f04c69671d1e6c1797fdcb6bc3476bf4;p=ghc-hetmet.git

[project @ 1999-10-14 13:33:19 by simonmar]
Allow unboxed tuples with zero components in unfoldings, CPR seems to
generate them occasionally (perhaps it shouldn't - there is very
little difference between returning () and (# #)).
---

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 83450fa..20cdf9f 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -424,6 +424,11 @@ context_list1	: class					{ [$1] }
 class		:: { (RdrName, [RdrNameHsType]) }
 class		:  qcls_name atypes			{ ($1, $2) }
 
+types0		:: { [RdrNameHsType] 			{- Zero or more -}  }	
+types0		:  {- empty -}				{ [ ] }
+		|  type					{ [ $1 ] }
+		|  types2				{ $1 }
+
 types2		:: { [RdrNameHsType] 			{- Two or more -}  }	
 types2		:  type ',' type			{ [$1,$3] }
 		|  type ',' types2			{ $1 : $3 }
@@ -442,8 +447,7 @@ atype		:: { RdrNameHsType }
 atype		:  qtc_name 			  	{ MonoTyVar $1 }
 		|  tv_name			  	{ MonoTyVar $1 }
 		|  '(' types2 ')'	  		{ MonoTupleTy $2 True{-boxed-} }
-		|  '(#' type '#)'  			{ MonoTupleTy [$2] False{-unboxed-} }
-		|  '(#' types2 '#)'			{ MonoTupleTy $2 False{-unboxed-} }
+		|  '(#' types0 '#)'			{ MonoTupleTy $2 False{-unboxed-} }
 		|  '[' type ']'		  		{ MonoListTy  $2 }
 		|  '{' qcls_name atypes '}'		{ MonoDictTy $2 $3 }
 		|  '(' type ')'		  		{ $2 }
@@ -653,12 +657,16 @@ core_aexpr      : qvar_name				        { UfVar $1 }
 		| core_lit		 { UfCon (UfLitCon $1) [] }
 		| '(' core_expr ')'	 { $2 }
 		| '(' comma_exprs2 ')'	 { UfTuple (mkTupConRdrName (length $2)) $2 }
-		| '(#' core_expr '#)'	 { UfTuple (mkUbxTupConRdrName 1) [$2] }
-		| '(#' comma_exprs2 '#)' { UfTuple (mkUbxTupConRdrName (length $2)) $2 }
+		| '(#' comma_exprs0 '#)' { UfTuple (mkUbxTupConRdrName (length $2)) $2 }
 
 -- This one is dealt with by qdata_name: see above comments
 --		| '('  ')'	 	 { UfTuple (mkTupConRdrName 0) [] }
 
+comma_exprs0    :: { [UfExpr RdrName] }	-- Zero or more
+comma_exprs0	: {- empty -}			{ [ ] }
+		| core_expr			{ [ $1 ] }
+		| comma_exprs2			{ $1 }
+
 comma_exprs2	:: { [UfExpr RdrName] }	-- Two or more
 comma_exprs2	: core_expr ',' core_expr			{ [$1,$3] }
 		| core_expr ',' comma_exprs2			{ $1 : $3 }