[project @ 2002-03-08 16:00:39 by simonmar]

[ghc-hetmet.git] / ghc / compiler / rename / ParseIface.y

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index ce9526c..0cc4a48 100644 (file)
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -46,12 +46,13 @@ import Type         ( Kind, mkArrowKind, liftedTypeKind, openTypeKind, usageTypeKind )
 import ForeignCall     ( ForeignCall(..), CCallConv(..), CCallSpec(..), CCallTarget(..) )
 import Lex             
 
-import RnMonad         ( ParsedIface(..), ExportItem, IfaceDeprecs ) 
+import RnMonad         ( ParsedIface(..), IfaceDeprecs ) 
 import HscTypes         ( WhetherHasOrphans, IsBootInterface, GenAvailInfo(..), 
                           ImportVersion, WhatsImported(..),
-                          RdrAvailInfo )
+                          RdrAvailInfo, RdrExportItem )
 
 import RdrName          ( RdrName, mkRdrUnqual, mkIfaceOrig )
+import TyCon           ( DataConDetails(..) )
 import Name            ( OccName )
 import OccName          ( mkSysOccFS,
                          tcName, varName, dataName, clsName, tvName,
@@ -243,7 +244,7 @@ name_version_pair   :  var_occ version                              { ($1, $2) }
 
 --------------------------------------------------------------------------
 
-exports_part   :: { [ExportItem] }
+exports_part   :: { [RdrExportItem] }
 exports_part   :                                       { [] }
                | '__export' mod_name entities ';'
                        exports_part                    { ({-mkSysModuleNameFS-} $2, $3) : $5 }
@@ -273,16 +274,16 @@ val_occs  :: { [OccName] }
 
 --------------------------------------------------------------------------
 
-fix_decl_part :: { [RdrNameFixitySig] }
+fix_decl_part :: { [(RdrName,Fixity)] }
 fix_decl_part : {- empty -}                            { [] }
              | fix_decls ';'                           { $1 }
 
-fix_decls     :: { [RdrNameFixitySig] }
+fix_decls     :: { [(RdrName,Fixity)] }
 fix_decls     :                                        { [] }
              | fix_decl fix_decls                      { $1 : $2 }
 
-fix_decl :: { RdrNameFixitySig }
-fix_decl : src_loc fixity prec var_or_data_name                { FixitySig $4 (Fixity $3 $2) $1 }
+fix_decl    :: { (RdrName,Fixity) }
+fix_decl    : fixity prec var_or_data_name             { ($3, Fixity $2 $1) }
 
 fixity      :: { FixityDirection }
 fixity      : 'infixl'                                  { InfixL }
@@ -337,9 +338,9 @@ decl    : src_loc qvar_name '::' type maybe_idinfo
        | src_loc 'foreign' 'type' qtc_name                    
                        { ForeignType $4 Nothing DNType $1 }
        | src_loc 'data' tycl_hdr constrs              
-                       { mkTyData DataType $3 $4 (length $4) Nothing $1 }
+                       { mkTyData DataType $3 $4 Nothing $1 }
        | src_loc 'newtype' tycl_hdr newtype_constr
-                       { mkTyData NewType $3 $4 1 Nothing $1 }
+                       { mkTyData NewType $3 (DataCons [$4]) Nothing $1 }
        | src_loc 'class' tycl_hdr fds csigs
                        { mkClassDecl $3 $4 $5 Nothing $1 }
 
@@ -452,9 +453,10 @@ opt_version        : version                       { $1 }
 
 ----------------------------------------------------------------------------
 
-constrs                :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
-               :                       { [] }
-               | '=' constrs1          { $2 }
+constrs                :: { DataConDetails RdrNameConDecl }
+               :                       { Unknown }
+               | '='                   { DataCons [] }
+               | '=' constrs1          { DataCons $2 }
 
 constrs1       :: { [RdrNameConDecl] }
 constrs1       :  constr               { [$1] }
@@ -465,10 +467,10 @@ constr            :  src_loc ex_stuff qdata_name batypes          { mk_con_decl $3 $2 (VanillaCon
                |  src_loc ex_stuff qdata_name '{' fields1 '}'  { mk_con_decl $3 $2 (RecCon $5)     $1 }
                 -- We use "data_fs" so as to include ()
 
-newtype_constr :: { [RdrNameConDecl] {- Not allowed to be empty -} }
-newtype_constr : src_loc '=' ex_stuff qdata_name atype { [mk_con_decl $4 $3 (VanillaCon [unbangedType $5]) $1] }
+newtype_constr :: { RdrNameConDecl }
+newtype_constr : src_loc '=' ex_stuff qdata_name atype { mk_con_decl $4 $3 (VanillaCon [unbangedType $5]) $1 }
                | src_loc '=' ex_stuff qdata_name '{' qvar_name '::' atype '}'
-                                                       { [mk_con_decl $4 $3 (RecCon [([$6], unbangedType $8)]) $1] }
+                                                       { mk_con_decl $4 $3 (RecCon [([$6], unbangedType $8)]) $1 }
 
 ex_stuff :: { ([HsTyVarBndr RdrName], RdrNameContext) }
 ex_stuff       :                                       { ([],[]) }
@@ -588,18 +590,18 @@ mod_name  :: { ModuleName }
 ---------------------------------------------------
 var_fs          :: { EncodedFS }
                : VARID                 { $1 }
-               | 'as'                  { SLIT("as") }
-               | 'qualified'           { SLIT("qualified") }
-               | 'hiding'              { SLIT("hiding") }
-               | 'forall'              { SLIT("forall") }
-               | 'foreign'             { SLIT("foreign") }
-               | 'export'              { SLIT("export") }
-               | 'label'               { SLIT("label") }
-               | 'dynamic'             { SLIT("dynamic") }
-               | 'unsafe'              { SLIT("unsafe") }
-               | 'with'                { SLIT("with") }
-               | 'ccall'               { SLIT("ccall") }
-               | 'stdcall'             { SLIT("stdcall") }
+               | 'as'                  { FSLIT("as") }
+               | 'qualified'           { FSLIT("qualified") }
+               | 'hiding'              { FSLIT("hiding") }
+               | 'forall'              { FSLIT("forall") }
+               | 'foreign'             { FSLIT("foreign") }
+               | 'export'              { FSLIT("export") }
+               | 'label'               { FSLIT("label") }
+               | 'dynamic'             { FSLIT("dynamic") }
+               | 'unsafe'              { FSLIT("unsafe") }
+               | 'with'                { FSLIT("with") }
+               | 'ccall'               { FSLIT("ccall") }
+               | 'stdcall'             { FSLIT("stdcall") }
 
 var_occ                :: { OccName }
                :  var_fs               { mkSysOccFS varName $1 }
@@ -684,9 +686,9 @@ kind                :: { Kind }
 
 akind          :: { Kind }
                 : '*'                   { liftedTypeKind }
-               | VARSYM                { if $1 == SLIT("?") then
+               | VARSYM                { if $1 == FSLIT("?") then
                                                openTypeKind
-                                         else if $1 == SLIT("\36") then
+                                         else if $1 == FSLIT("\36") then
                                                 usageTypeKind  -- dollar
                                           else panic "ParseInterface: akind"
                                        }