X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParserCore.y;h=a9669b23ec4619608b42aa0d47267c6a93584aa0;hb=16513d4899e167d20e120c2b3907230b7ff9dd83;hp=3210583f9651cfa70247dadca7adafb2fa17fd42;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
index 3210583..a9669b2 100644
--- a/compiler/parser/ParserCore.y
+++ b/compiler/parser/ParserCore.y
@@ -10,6 +10,7 @@ import OccName
 import Kind( Kind(..) )
 import Name( nameOccName, nameModule )
 import Module
+import PackageConfig	( mainPackageId )
 import ParserCoreUtils
 import LexCore
 import Literal
@@ -72,7 +73,8 @@ module	:: { HsExtCore RdrName }
          : '%module' modid tdefs vdefgs { HsExtCore $2 $3 $4 }
 
 modid	:: { Module }
-	: CNAME	                 { mkModuleFS (mkFastString $1) }
+        : CNAME	                 { mkModule mainPackageId  -- ToDo: wrong
+		  			(mkModuleNameFS (mkFastString $1)) }
 
 -------------------------------------------------------------
 --     Type and newtype declarations are in HsSyn syntax
@@ -82,7 +84,7 @@ tdefs	:: { [TyClDecl RdrName] }
 	| tdef ';' tdefs	{$1:$3}
 
 tdef	:: { TyClDecl RdrName }
-	: '%data' q_tc_name tv_bndrs '=' '{' cons1 '}'
+	: '%data' q_tc_name tv_bndrs '=' '{' cons '}'
                 { mkTyData DataType (noLoc [], noLoc (ifaceExtRdrName $2), map toHsTvBndr $3) Nothing $6 Nothing }
 	| '%newtype' q_tc_name tv_bndrs trep 
 		{ let tc_rdr = ifaceExtRdrName $2 in
@@ -97,9 +99,9 @@ trep    :: { OccName -> [LConDecl RdrName] }
 			                in [noLoc $ ConDecl (noLoc dc_name) Explicit []
 					   (noLoc []) con_info ResTyH98]) }
 
-cons1	:: { [LConDecl RdrName] }
-	: con		{ [$1] }
-	| con ';' cons1	{ $1:$3 }
+cons	:: { [LConDecl RdrName] }
+	: {- empty -}	{ [] } -- 20060420 Empty data types allowed. jds
+	| con ';' cons	{ $1:$3 }
 
 con	:: { LConDecl RdrName }
 	: d_pat_occ attv_bndrs hs_atys 
@@ -168,7 +170,7 @@ vdef	:: { (IfaceIdBndr, IfaceExpr) }
   -- same as the module being compiled, and Iface syntax only
   -- has OccNames in binding positions
 
-qd_occ :: { OccName }
+qd_occ :: { FastString }
         : var_occ { $1 }
         | d_occ   { $1 }
 
@@ -212,7 +214,7 @@ kind 	:: { IfaceKind }
 
 aexp    :: { IfaceExpr }
 	: var_occ	         { IfaceLcl $1 }
-	| modid '.' qd_occ	 { IfaceExt (ExtPkg $1 $3) }
+        | modid '.' qd_occ	 { IfaceExt (ExtPkg $1 (mkVarOccFS $3)) }
 	| lit		{ IfaceLit $1 }
 	| '(' exp ')' 	{ $2 }
 
@@ -232,7 +234,6 @@ exp	:: { IfaceExpr }
 	| '%note' STRING exp 	   
 	    { case $2 of
 	       --"SCC"      -> IfaceNote (IfaceSCC "scc") $3
-	       "InlineCall" -> IfaceNote IfaceInlineCall $3
 	       "InlineMe"   -> IfaceNote IfaceInlineMe $3
             }
         | '%external' STRING aty   { IfaceFCall (ForeignCall.CCall 
@@ -261,11 +262,11 @@ lit	:: { Literal }
 	| '(' CHAR '::' aty ')'		{ MachChar $2 }
 	| '(' STRING '::' aty ')'	{ MachStr (mkFastString $2) }
 
-tv_occ	:: { OccName }
-	: NAME	{ mkOccName tvName $1 }
+tv_occ	:: { FastString }
+	: NAME	{ mkFastString $1 }
 
-var_occ	:: { OccName }
-	: NAME	{ mkVarOcc $1 }
+var_occ	:: { FastString }
+	: NAME	{ mkFastString $1 }
 
 
 -- Type constructor
@@ -279,8 +280,8 @@ d_pat_occ :: { OccName }
 
 -- Data constructor occurrence in an expression;
 -- use the varName because that's the worker Id
-d_occ :: { OccName }
-       : CNAME { mkVarOcc $1 }
+d_occ :: { FastString }
+       : CNAME { mkFastString $1 }
 
 {
 
@@ -315,14 +316,14 @@ eqTc (IfaceTc (ExtPkg mod occ)) tycon
 -- are very limited (see the productions for 'ty', so the translation
 -- isn't hard
 toHsType :: IfaceType -> LHsType RdrName
-toHsType (IfaceTyVar v)        		 = noLoc $ HsTyVar (mkRdrUnqual v)
+toHsType (IfaceTyVar v)        		 = noLoc $ HsTyVar (mkRdrUnqual (mkTyVarOcc v))
 toHsType (IfaceAppTy t1 t2)    		 = noLoc $ HsAppTy (toHsType t1) (toHsType t2)
 toHsType (IfaceFunTy t1 t2)    		 = noLoc $ HsFunTy (toHsType t1) (toHsType t2)
 toHsType (IfaceTyConApp (IfaceTc tc) ts) = foldl mkHsAppTy (noLoc $ HsTyVar (ifaceExtRdrName tc)) (map toHsType ts) 
 toHsType (IfaceForAllTy tv t)            = add_forall (toHsTvBndr tv) (toHsType t)
 
 toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName
-toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual tv) k
+toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOcc tv)) k
 
 ifaceExtRdrName :: IfaceExtName -> RdrName
 ifaceExtRdrName (ExtPkg mod occ) = mkOrig mod occ