[project @ 2005-10-14 11:22:41 by simonpj]

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

diff --git a/ghc/compiler/parser/ParserCore.y b/ghc/compiler/parser/ParserCore.y
index 75f7b1b..b41f3f4 100644 (file)
--- a/ghc/compiler/parser/ParserCore.y
+++ b/ghc/compiler/parser/ParserCore.y
@@ -8,7 +8,7 @@ import HsSyn
 import RdrName
 import OccName
 import Kind( Kind(..) )
-import Name( nameOccName, nameModuleName )
+import Name( nameOccName, nameModule )
 import Module
 import ParserCoreUtils
 import LexCore
@@ -69,11 +69,10 @@ import Char
 %%
 
 module :: { HsExtCore RdrName }
-         : '%module' modid tdefs vdefgs
-               { HsExtCore (mkHomeModule $2) $3 $4 }
+         : '%module' modid tdefs vdefgs { HsExtCore $2 $3 $4 }
 
-modid  :: { ModuleName }
-       : CNAME                  { mkSysModuleNameFS (mkFastString $1) }
+modid  :: { Module }
+       : CNAME                  { mkSysModuleFS (mkFastString $1) }
 
 -------------------------------------------------------------
 --     Type and newtype declarations are in HsSyn syntax
@@ -95,8 +94,8 @@ trep    :: { OccName -> [LConDecl RdrName] }
         : {- empty -}   { (\ tc_occ -> []) }
         | '=' ty        { (\ tc_occ -> let { dc_name  = mkRdrUnqual (setOccNameSpace dataName tc_occ) ;
                                             con_info = PrefixCon [toHsType $2] }
-                                       in [noLoc $ ConDecl (noLoc dc_name) []
-                                          (noLoc []) con_info]) }
+                                       in [noLoc $ ConDecl (noLoc dc_name) Explicit []
+                                          (noLoc []) con_info ResTyH98]) }
 
 cons1  :: { [LConDecl RdrName] }
        : con           { [$1] }
@@ -104,9 +103,15 @@ cons1      :: { [LConDecl RdrName] }
 
 con    :: { LConDecl RdrName }
        : d_pat_occ attv_bndrs hs_atys 
-               { noLoc $ ConDecl (noLoc (mkRdrUnqual $1)) $2 (noLoc []) (PrefixCon $3)}
+               { noLoc $ ConDecl (noLoc (mkRdrUnqual $1)) Explicit $2 (noLoc []) (PrefixCon $3) ResTyH98}
         | d_pat_occ '::' ty
-                { noLoc $ GadtDecl (noLoc (mkRdrUnqual $1)) (toHsType $3) } 
+                -- XXX - autrijus - $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.
+                -- extractWhatEver to unpack ty into the parts to ConDecl
+                -- XXX - define it somewhere in RdrHsSyn
+               { noLoc $ ConDecl (noLoc (mkRdrUnqual $1)) Explicit [] (noLoc []) (PrefixCon []) (undefined $3) }
 
 attv_bndrs :: { [LHsTyVarBndr RdrName] }
        : {- empty -}            { [] }
@@ -132,6 +137,7 @@ aty :: { IfaceType }
 bty    :: { IfaceType }
        : tv_occ atys    { foldl IfaceAppTy (IfaceTyVar $1) $2 }
         | q_tc_name atys  { IfaceTyConApp (IfaceTc $1) $2 }
+        | '(' ty ')' { $2 }
 
 ty     :: { IfaceType }
        : bty                        { $1 }
@@ -299,7 +305,7 @@ convRatLit i aty
 
 eqTc :: IfaceTyCon -> TyCon -> Bool   -- Ugh!
 eqTc (IfaceTc (ExtPkg mod occ)) tycon
-  = mod == nameModuleName nm && occ == nameOccName nm
+  = mod == nameModule nm && occ == nameOccName nm
   where
     nm = tyConName tycon