X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y.pp;h=b4acb890eb4228c97364c4abddbb26c23ae71e9d;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=4a1519a47fbaa1027c873e1f229782f9b9f66975;hpb=9c30856ddafb6de78811cf5e8f1b9a8c773ddd5d;p=ghc-hetmet.git

diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
index 4a1519a..b4acb89 100644
--- a/ghc/compiler/parser/Parser.y.pp
+++ b/ghc/compiler/parser/Parser.y.pp
@@ -25,7 +25,7 @@ import Type		( funTyCon )
 import ForeignCall	( Safety(..), CExportSpec(..), CLabelString,
 			  CCallConv(..), CCallTarget(..), defaultCCallConv
 			)
-import OccName		( UserFS, varName, dataName, tcClsName, tvName )
+import OccName		( varName, dataName, tcClsName, tvName )
 import DataCon		( DataCon, dataConName )
 import SrcLoc		( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
 			  SrcSpan, combineLocs, srcLocFile, 
@@ -34,9 +34,8 @@ import Module
 import StaticFlags	( opt_SccProfilingOn )
 import Type		( Kind, mkArrowKind, liftedTypeKind )
 import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
-			  Activation(..), InlineSpec(..), defaultInlineSpec )
+			  Activation(..), defaultInlineSpec )
 import OrdList
-import Panic
 
 import FastString
 import Maybes		( orElse )
@@ -455,20 +454,16 @@ tycl_decl :: { LTyClDecl RdrName }
  		{% do { (tc,tvs) <- checkSynHdr $2
 		      ; return (LL (TySynonym tc tvs $4)) } }
 
-	| 'data' tycl_hdr constrs deriving
+	| data_or_newtype tycl_hdr constrs deriving
 		{ L (comb4 $1 $2 $3 $4)	-- We need the location on tycl_hdr 
 					-- in case constrs and deriving are both empty
-		    (mkTyData DataType $2 Nothing (reverse (unLoc $3)) (unLoc $4)) }
+		    (mkTyData (unLoc $1) (unLoc $2) Nothing (reverse (unLoc $3)) (unLoc $4)) }
 
-        | 'data' tycl_hdr opt_kind_sig 
+        | data_or_newtype tycl_hdr opt_kind_sig 
 		 'where' gadt_constrlist
 		 deriving
 		{ L (comb4 $1 $2 $4 $5)
-		    (mkTyData DataType $2 $3 (reverse (unLoc $5)) (unLoc $6)) }
-
-	| 'newtype' tycl_hdr '=' newconstr deriving
-		{ L (comb3 $1 $4 $5)
-		    (mkTyData NewType $2 Nothing [$4] (unLoc $5)) }
+		    (mkTyData (unLoc $1) (unLoc $2) $3 (reverse (unLoc $5)) (unLoc $6)) }
 
 	| 'class' tycl_hdr fds where
 		{ let 
@@ -477,6 +472,10 @@ tycl_decl :: { LTyClDecl RdrName }
 	 	  L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs 
 					  binds) }
 
+data_or_newtype :: { Located NewOrData }
+	: 'data'	{ L1 DataType }
+	| 'newtype'	{ L1 NewType }
+
 opt_kind_sig :: { Maybe Kind }
 	: 				{ Nothing }
 	| '::' kind			{ Just $2 }
@@ -852,11 +851,6 @@ akind	:: { Kind }
 -----------------------------------------------------------------------------
 -- Datatype declarations
 
-newconstr :: { LConDecl RdrName }
-	: conid atype	{ LL $ ConDecl $1 Explicit [] (noLoc []) (PrefixCon [$2]) ResTyH98 }
-	| conid '{' var '::' ctype '}'
-			{ LL $ ConDecl $1 Explicit [] (noLoc []) (RecCon [($3, $5)]) ResTyH98 }
-
 gadt_constrlist :: { Located [LConDecl RdrName] }
 	: '{'            gadt_constrs '}'	{ LL (unLoc $2) }
 	|     vocurly    gadt_constrs close	{ $2 }
@@ -1475,7 +1469,7 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-'
 -- 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
-special_id :: { Located UserFS }
+special_id :: { Located FastString }
 special_id
 	: 'as'			{ L1 FSLIT("as") }
 	| 'qualified'		{ L1 FSLIT("qualified") }
@@ -1486,7 +1480,7 @@ special_id
 	| 'stdcall'             { L1 FSLIT("stdcall") }
 	| 'ccall'               { L1 FSLIT("ccall") }
 
-special_sym :: { Located UserFS }
+special_sym :: { Located FastString }
 special_sym : '!'	{ L1 FSLIT("!") }
 	    | '.' 	{ L1 FSLIT(".") }
  	    | '*' 	{ L1 FSLIT("*") }