Take away XXXs in GADT records related code that are no longer TODOs.

[ghc-hetmet.git] / compiler / parser / ParserCore.y

diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
index 3210583..f2d48da 100644 (file)
--- 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,15 +99,15 @@ 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 
                { noLoc $ ConDecl (noLoc (mkRdrUnqual $1)) Explicit $2 (noLoc []) (PrefixCon $3) ResTyH98}
         | d_pat_occ '::' ty
-                -- XXX - autrijus - $3 needs to be split into argument and return types!
+                -- XXX - audreyt - $3 needs to be split into argument and return types!
                 -- also not sure whether the [] below (quantified vars) appears.
                 -- also the "PrefixCon []" is wrong.
                 -- also we want to munge $3 somehow.
@@ -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