[project @ 2000-10-17 14:40:26 by sewardj]

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

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index e91ee02..c83a0f8 100644 (file)
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -44,36 +44,31 @@ import BasicTypes   ( Fixity(..), FixityDirection(..),
 import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
 import CallConv         ( cCallConv )
 import HsPragmas       ( noDataPragmas, noClassPragmas )
-import Type            ( Kind, mkArrowKind, boxedTypeKind, openTypeKind, UsageAnn(..) )
-import IdInfo           ( ArityInfo, exactArity, CprInfo(..), InlinePragInfo(..) )
+import Type            ( Kind, mkArrowKind, boxedTypeKind, openTypeKind )
+import IdInfo           ( exactArity, InlinePragInfo(..) )
 import PrimOp           ( CCall(..), CCallTarget(..) )
 import Lex             
 
-import RnMonad         ( ImportVersion, ParsedIface(..), WhatsImported(..),
-                         RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..), 
-                          WhetherHasOrphans, IsBootInterface
-                       ) 
-import Bag             ( emptyBag, unitBag, snocBag )
-import FiniteMap       ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
-import RdrName          ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual, mkRdrNameWkr )
-import Name            ( OccName, Provenance )
+import RnMonad         ( ParsedIface(..) ) 
+import HscTypes         ( WhetherHasOrphans, IsBootInterface, GenAvailInfo(..), 
+                          ImportVersion, ExportItem, WhatsImported(..),
+                          RdrAvailInfo )
+
+import RdrName          ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual )
+import Name            ( OccName )
 import OccName          ( mkSysOccFS,
                          tcName, varName, ipName, dataName, clsName, tvName, uvName,
                          EncodedFS 
                        )
-import Module           ( ModuleName, PackageName, mkSysModuleFS, mkModule )                   
+import Module           ( ModuleName, PackageName, mkSysModuleNameFS, mkModule )
 import SrcLoc          ( SrcLoc )
 import CmdLineOpts     ( opt_InPackage )
-import Maybes
 import Outputable
 import List            ( insert )
+import Class            ( DefMeth (..) )
 
 import GlaExts
 import FastString      ( tailFS )
-
-#if __HASKELL1__ > 4
-import Ratio ( (%) )
-#endif
 }
 
 %name      parseIface
@@ -134,6 +129,7 @@ import Ratio ( (%) )
  '__word64'    { ITword64_lit }
  '__rational'  { ITrational_lit }
  '__addr'      { ITaddr_lit }
+ '__label'     { ITlabel_lit }
  '__litlit'    { ITlit_lit }
  '__string'    { ITstring_lit }
  '__ccall'     { ITccall $$ }
@@ -169,6 +165,8 @@ import Ratio ( (%) )
 
  '{'           { ITocurly }                    -- special symbols
  '}'           { ITccurly }
+ '{|'          { ITocurlybar }                         -- special symbols
+ '|}'          { ITccurlybar }                         -- special symbols
  '['           { ITobrack }
  ']'           { ITcbrack }
  '('           { IToparen }
@@ -249,7 +247,7 @@ import_part :                                                 { [] }
            
 import_decl :: { ImportVersion OccName }
 import_decl : 'import' mod_name orphans is_boot whats_imported ';'
-                       { (mkSysModuleFS $2, $3, $4, $5) }
+                       { ({-mkSysModuleNameFS-} $2, $3, $4, $5) }
 
 orphans                    :: { WhetherHasOrphans }
 orphans                    :                                           { False }
@@ -278,7 +276,7 @@ name_version_pair   :  var_occ version                              { ($1, $2) }
 exports_part   :: { [ExportItem] }
 exports_part   :                                       { [] }
                | '__export' mod_name entities ';'
-                       exports_part                    { (mkSysModuleFS $2, $3) : $5 }
+                       exports_part                    { ({-mkSysModuleNameFS-} $2, $3) : $5 }
 
 entities       :: { [RdrAvailInfo] }
 entities       :                                       { [] }
@@ -338,8 +336,10 @@ csigs1             :                               { [] }
                | csig ';' csigs1               { $1 : $3 }
 
 csig           :: { RdrNameSig }
-csig           :  src_loc var_name '::' type           { mkClassOpSig False $2 $4 $1 }
-               |  src_loc var_name '=' '::' type       { mkClassOpSig True  $2 $5 $1 }
+csig           :  src_loc var_name '::' type           { mkClassOpSig NoDefMeth $2 $4 $1 }
+               |  src_loc var_name '=' '::' type       { mkClassOpSig (DefMeth (error "DefMeth") )
+                                                               $2 $5 $1 }
+               |  src_loc var_name ';' '::' type       { mkClassOpSig GenDefMeth  $2 $5 $1 }           
 
 --------------------------------------------------------------------------
 
@@ -352,7 +352,7 @@ inst_decl   :  src_loc 'instance' type '=' var_name ';'
                        { InstDecl $3
                                   EmptyMonoBinds       {- No bindings -}
                                   []                   {- No user pragmas -}
-                                  $5                   {- Dfun id -}
+                                  (Just $5)            {- Dfun id -}
                                   $1
                        }
 
@@ -369,9 +369,9 @@ decl    : src_loc var_name '::' type maybe_idinfo
        | src_loc 'type' tc_name tv_bndrs '=' type                     
                        { TyClD (TySynonym $3 $4 $6 $1) }
        | src_loc 'data' opt_decl_context tc_name tv_bndrs constrs             
-                       { TyClD (TyData DataType $3 $4 $5 $6 (length $6) Nothing noDataPragmas $1) }
+                       { TyClD (mkTyData DataType $3 $4 $5 $6 (length $6) Nothing noDataPragmas $1) }
        | src_loc 'newtype' opt_decl_context tc_name tv_bndrs newtype_constr
-                       { TyClD (TyData NewType $3 $4 $5 $6 1 Nothing noDataPragmas $1) }
+                       { TyClD (mkTyData NewType $3 $4 $5 $6 1 Nothing noDataPragmas $1) }
        | src_loc 'class' opt_decl_context tc_name tv_bndrs fds csigs
                        { TyClD (mkClassDecl $3 $4 $5 $6 $7 EmptyMonoBinds 
                                        noClassPragmas $1) }
@@ -469,9 +469,9 @@ constr              :  src_loc ex_stuff data_name batypes           { mk_con_decl $3 $2 (VanillaCon $
                 -- We use "data_fs" so as to include ()
 
 newtype_constr :: { [RdrNameConDecl] {- Not allowed to be empty -} }
-newtype_constr : src_loc '=' ex_stuff data_name atype  { [mk_con_decl $4 $3 (NewCon $5 Nothing) $1] }
+newtype_constr : src_loc '=' ex_stuff data_name atype  { [mk_con_decl $4 $3 (VanillaCon [Unbanged $5]) $1] }
                | src_loc '=' ex_stuff data_name '{' var_name '::' atype '}'
-                                                       { [mk_con_decl $4 $3 (NewCon $8 (Just $6)) $1] }
+                                                       { [mk_con_decl $4 $3 (RecCon [([$6], Unbanged $8)]) $1] }
 
 ex_stuff :: { ([HsTyVarBndr RdrName], RdrNameContext) }
 ex_stuff       :                                       { ([],[]) }
@@ -563,7 +563,7 @@ package             :: { PackageName }
                                                                -- Module loops are always within a package
 
 mod_name       :: { ModuleName }
-               :  CONID                { mkSysModuleFS $1 }
+               :  CONID                { mkSysModuleNameFS $1 }
 
 
 ---------------------------------------------------
@@ -856,6 +856,7 @@ core_lit    : integer                       { mkMachInt $1 }
                | '__int64' integer             { mkMachInt64 $2 }
                | '__float' rational            { MachFloat $2 }
                | '__addr' integer              { MachAddr $2 }
+               | '__label' STRING              { MachLabel $2 }
 
 integer                :: { Integer }
                : INTEGER                       { $1 }