[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 c854f14..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
@@ -170,6 +165,8 @@ import Ratio ( (%) )
 
  '{'           { ITocurly }                    -- special symbols
  '}'           { ITccurly }
+ '{|'          { ITocurlybar }                         -- special symbols
+ '|}'          { ITccurlybar }                         -- special symbols
  '['           { ITobrack }
  ']'           { ITcbrack }
  '('           { IToparen }
@@ -250,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 }
@@ -279,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       :                                       { [] }
@@ -339,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 }           
 
 --------------------------------------------------------------------------
 
@@ -370,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) }
@@ -470,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       :                                       { ([],[]) }
@@ -564,7 +563,7 @@ package             :: { PackageName }
                                                                -- Module loops are always within a package
 
 mod_name       :: { ModuleName }
-               :  CONID                { mkSysModuleFS $1 }
+               :  CONID                { mkSysModuleNameFS $1 }
 
 
 ---------------------------------------------------