[project @ 1999-07-15 14:08:03 by keithw]
[ghc-hetmet.git] / ghc / compiler / rename / ParseIface.y
index 9d26262..3621264 100644 (file)
 {
-#include "HsVersions.h"
-module ParseIface ( parseIface ) where
+module ParseIface ( parseIface, IfaceStuff(..) ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
 import HsSyn           -- quite a bit of stuff
 import RdrHsSyn                -- oodles of synonyms
-import HsDecls         ( HsIdInfo(..) )
-import HsTypes         ( mkHsForAllTy )
+import HsTypes         ( mkHsForAllTy, mkHsUsForAllTy )
 import HsCore
-import Literal
-import BasicTypes      ( Fixity(..), FixityDirection(..), NewOrData(..), Version(..) )
+import Const           ( Literal(..), mkMachInt_safe )
+import BasicTypes      ( Fixity(..), FixityDirection(..), 
+                         NewOrData(..), Version
+                       )
+import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
 import HsPragmas       ( noDataPragmas, noClassPragmas )
-import Kind            ( Kind, mkArrowKind, mkBoxedTypeKind )
-import IdInfo           ( ArgUsageInfo, FBTypeInfo )
+import Type            ( Kind, mkArrowKind, boxedTypeKind, openTypeKind, UsageAnn(..) )
+import IdInfo           ( ArityInfo, exactArity, CprInfo(..) )
 import Lex             
 
-import RnMonad         ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
-                         SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
+import RnMonad         ( ImportVersion, LocalVersion, ParsedIface(..), WhatsImported(..),
+                         RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..), WhetherHasOrphans
                        ) 
 import Bag             ( emptyBag, unitBag, snocBag )
 import FiniteMap       ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
-import Name            ( OccName(..), isTCOcc, Provenance, SYN_IE(Module) )
-import SrcLoc          ( mkIfaceSrcLoc )
---import Util          ( panic{-, pprPanic ToDo:rm-} )
-import ParseType        ( parseType )
-import ParseUnfolding   ( parseUnfolding )
+import RdrName          ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual )
+import Name            ( OccName, Provenance )
+import OccName          ( mkSysOccFS,
+                         tcName, varName, dataName, clsName, tvName, uvName,
+                         EncodedFS 
+                       )
+import Module           ( ModuleName, mkSysModuleFS )                  
+import PrelMods         ( mkTupNameStr, mkUbxTupNameStr )
+import PrelInfo         ( mkTupConRdrName, mkUbxTupConRdrName )
+import SrcLoc          ( SrcLoc )
 import Maybes
+import Outputable
 
------------------------------------------------------------------
-
-parseIface ls = parseIToks (lexIface ls)
+import GlaExts
 
------------------------------------------------------------------
+#if __HASKELL1__ > 4
+import Ratio ( (%) )
+#endif
 }
 
-%name      parseIToks
-%tokentype  { IfaceToken }
-%monad     { IfM }{ thenIf }{ returnIf }
+%name      parseIface
+%tokentype  { Token }
+%monad     { P }{ thenP }{ returnP }
+%lexer      { lexer } { ITeof }
 
 %token
-       INTERFACE           { ITinterface }
-       USAGES_PART         { ITusages }
-       VERSIONS_PART       { ITversions }
-       EXPORTS_PART        { ITexports }
-       INSTANCE_MODULES_PART { ITinstance_modules }
-       INSTANCES_PART      { ITinstances }
-       FIXITIES_PART       { ITfixities }
-       DECLARATIONS_PART   { ITdeclarations }
-       PRAGMAS_PART        { ITpragmas }
-       DATA                { ITdata }
-       TYPE                { ITtype }
-       NEWTYPE             { ITnewtype }
-       DERIVING            { ITderiving }
-       CLASS               { ITclass }
-       WHERE               { ITwhere }
-       INSTANCE            { ITinstance }
-       INFIXL              { ITinfixl }
-       INFIXR              { ITinfixr }
-       INFIX               { ITinfix }
-       FORALL              { ITforall }
-       BANG                { ITbang }
-       VBAR                { ITvbar }
-       DCOLON              { ITdcolon }
-       COMMA               { ITcomma }
-       DARROW              { ITdarrow }
-       DOTDOT              { ITdotdot }
-       EQUAL               { ITequal }
-       OCURLY              { ITocurly }
-       OBRACK              { ITobrack }
-       OPAREN              { IToparen }
-       RARROW              { ITrarrow }
-       CCURLY              { ITccurly }
-       CBRACK              { ITcbrack }
-       CPAREN              { ITcparen }
-       SEMI                { ITsemi }
-
-       VARID               { ITvarid    $$ }
-       CONID               { ITconid    $$ }
-       VARSYM              { ITvarsym   $$ }
-       CONSYM              { ITconsym   $$ }
-       QVARID              { ITqvarid   $$ }
-       QCONID              { ITqconid   $$ }
-       QVARSYM             { ITqvarsym  $$ }
-       QCONSYM             { ITqconsym  $$ }
-
-       IDINFO_PART     { ITidinfo $$ }
-       TYPE_PART       { ITtysig $$ }
-       ARITY_PART      { ITarity }
-       STRICT_PART     { ITstrict }
-       UNFOLD_PART     { ITunfold $$ }
-       DEMAND          { ITdemand $$ }
-       BOTTOM          { ITbottom }
-       LAM             { ITlam }
-       BIGLAM          { ITbiglam }
-       CASE            { ITcase }
-       PRIM_CASE       { ITprim_case }
-       LET             { ITlet }
-       LETREC          { ITletrec }
-       IN              { ITin }
-       OF              { ITof }
-       COERCE_IN       { ITcoerce_in }
-       COERCE_OUT      { ITcoerce_out }
-       ATSIGN          { ITatsign }
-       CCALL           { ITccall $$ }
-       SCC             { ITscc $$ }
-
-       CHAR            { ITchar $$ }
-       STRING          { ITstring $$ } 
-       INTEGER         { ITinteger  $$ }
-       DOUBLE          { ITdouble $$ }
-
-       INTEGER_LIT     { ITinteger_lit }
-       FLOAT_LIT       { ITfloat_lit }
-       RATIONAL_LIT    { ITrational_lit }
-       ADDR_LIT        { ITaddr_lit }
-       LIT_LIT         { ITlit_lit }
-       STRING_LIT      { ITstring_lit }
-
-       UNKNOWN         { ITunknown $$ }
+ 'case'        { ITcase }                      -- Haskell keywords
+ 'class'       { ITclass } 
+ 'data'        { ITdata } 
+ 'default'     { ITdefault }
+ 'deriving'    { ITderiving }
+ 'do'          { ITdo }
+ 'else'        { ITelse }
+ 'if'          { ITif }
+ 'import'      { ITimport }
+ 'in'          { ITin }
+ 'infix'       { ITinfix }
+ 'infixl'      { ITinfixl }
+ 'infixr'      { ITinfixr }
+ 'instance'    { ITinstance }
+ 'let'                 { ITlet }
+ 'module'      { ITmodule }
+ 'newtype'     { ITnewtype }
+ 'of'          { ITof }
+ 'then'        { ITthen }
+ 'type'        { ITtype }
+ 'where'       { ITwhere }
+ 'as'          { ITas }
+ 'qualified'   { ITqualified }
+ 'hiding'      { IThiding }
+
+ 'forall'      { ITforall }                    -- GHC extension keywords
+ 'foreign'     { ITforeign }
+ 'export'      { ITexport }
+ 'label'       { ITlabel } 
+ 'dynamic'     { ITdynamic }
+ 'unsafe'      { ITunsafe }
+
+ '__interface' { ITinterface }                 -- interface keywords
+ '__export'    { IT__export }
+ '__forall'    { IT__forall }
+ '__depends'   { ITdepends }
+ '__letrec'    { ITletrec }
+ '__coerce'    { ITcoerce }
+ '__inline_call'{ ITinlineCall }
+ '__inline_me'  { ITinlineMe }
+ '__DEFAULT'   { ITdefaultbranch }
+ '__bot'       { ITbottom }
+ '__integer'   { ITinteger_lit }
+ '__float'     { ITfloat_lit }
+ '__rational'  { ITrational_lit }
+ '__addr'      { ITaddr_lit }
+ '__litlit'    { ITlit_lit }
+ '__string'    { ITstring_lit }
+ '__ccall'     { ITccall $$ }
+ '__scc'       { ITscc }
+ '__sccC'       { ITsccAllCafs }
+
+ '__u'         { ITusage }
+ '__fuall'     { ITfuall }
+
+ '__A'         { ITarity }
+ '__P'         { ITspecialise }
+ '__C'         { ITnocaf }
+ '__U'         { ITunfold $$ }
+ '__S'         { ITstrict $$ }
+ '__R'         { ITrules }
+ '__M'         { ITcprinfo $$ }
+
+ '..'          { ITdotdot }                    -- reserved symbols
+ '::'          { ITdcolon }
+ '='           { ITequal }
+ '\\'          { ITlam }
+ '|'           { ITvbar }
+ '<-'          { ITlarrow }
+ '->'          { ITrarrow }
+ '@'           { ITat }
+ '~'           { ITtilde }
+ '=>'          { ITdarrow }
+ '-'           { ITminus }
+ '!'           { ITbang }
+
+ '/\\'         { ITbiglam }                    -- GHC-extension symbols
+
+ '{'           { ITocurly }                    -- special symbols
+ '}'           { ITccurly }
+ '['           { ITobrack }
+ ']'           { ITcbrack }
+ '('           { IToparen }
+ ')'           { ITcparen }
+ '(#'          { IToubxparen }
+ '#)'          { ITcubxparen }
+ ';'           { ITsemi }
+ ','           { ITcomma }
+
+ VARID         { ITvarid    $$ }               -- identifiers
+ CONID         { ITconid    $$ }
+ VARSYM        { ITvarsym   $$ }
+ CONSYM        { ITconsym   $$ }
+ QVARID        { ITqvarid   $$ }
+ QCONID        { ITqconid   $$ }
+ QVARSYM       { ITqvarsym  $$ }
+ QCONSYM       { ITqconsym  $$ }
+
+ PRAGMA                { ITpragma   $$ }
+
+ CHAR          { ITchar     $$ }
+ STRING                { ITstring   $$ }
+ INTEGER       { ITinteger  $$ }
+ RATIONAL      { ITrational $$ }
+ CLITLIT       { ITlitlit   $$ }
+
+ UNKNOWN       { ITunknown  $$ }
 %%
 
-iface          :: { ParsedIface }
-iface          : INTERFACE CONID INTEGER
-                 inst_modules_part 
-                 usages_part
-                 exports_part fixities_part
-                 instances_part
+-- iface_stuff is the main production.
+-- It recognises (a) a whole interface file
+--              (b) a type (so that type sigs can be parsed lazily)
+--              (c) the IdInfo part of a signature (same reason)
+
+iface_stuff :: { IfaceStuff }
+iface_stuff : iface            { let (nm, iff) = $1 in PIface nm iff }
+           | type              { PType   $1 }
+           | id_info           { PIdInfo $1 }
+           | '__R' rules       { PRules  $2 }
+
+
+iface          :: { (ModuleName, ParsedIface) }
+iface          : '__interface' mod_fs INTEGER orphans checkVersion 'where'
+                 exports_part
+                  import_part
+                 instance_decl_part
                  decls_part
-                 { ParsedIface 
-                       $2                      -- Module name
-                       (fromInteger $3)        -- Module version
-                       $5                      -- Usages
-                       $6                      -- Exports
-                       $4                      -- Instance modules
-                       $7                      -- Fixities
-                       $9                      -- Decls
-                       $8                      -- Local instances
-                   }
-
-
-usages_part        :: { [ImportVersion OccName] }
-usages_part        :  USAGES_PART module_stuff_pairs           { $2 }
-                   |                                           { [] }
-
-module_stuff_pairs  :: { [ImportVersion OccName] }
-module_stuff_pairs  :                                                  { [] }
-                   |  module_stuff_pair module_stuff_pairs     { $1 : $2 }
-
-module_stuff_pair   ::  { ImportVersion OccName }
-module_stuff_pair   :  mod_name INTEGER DCOLON name_version_pairs SEMI
-                       { ($1, fromInteger $2, $4) }
-
-versions_part      :: { [LocalVersion OccName] }
-versions_part      :  VERSIONS_PART name_version_pairs         { $2 }
-                   |                                           { [] }
+                 rules_part
+                 { ( $2                        -- Module name
+                   , ParsedIface {
+                       pi_mod = fromInteger $3,        -- Module version
+                       pi_orphan  = $4,
+                       pi_exports = $7,        -- Exports
+                       pi_usages  = $8,        -- Usages
+                       pi_insts   = $9,        -- Local instances
+                       pi_decls   = $10,       -- Decls
+                       pi_rules   = $11        -- Rules 
+                     } ) }
+
+--------------------------------------------------------------------------
+
+import_part :: { [ImportVersion OccName] }
+import_part :                                            { [] }
+           |  import_part import_decl                    { $2 : $1 }
+           
+import_decl :: { ImportVersion OccName }
+import_decl : 'import' mod_fs INTEGER orphans whats_imported ';'
+                       { (mkSysModuleFS $2, fromInteger $3, $4, $5) }
+       -- import Foo 3 :: a 1 b 3 c 7 ;        means import a,b,c from Foo
+       -- import Foo 3 ;                       means import all of Foo
+       -- import Foo 3 ! :: ...stuff... ;      the ! means that Foo contains orphans
+
+orphans                    :: { WhetherHasOrphans }
+orphans                    :                                           { False }
+                   | '!'                                       { True }
+
+whats_imported      :: { WhatsImported OccName }
+whats_imported      :                                           { Everything }
+                    | '::' name_version_pairs                  { Specifically $2 }
 
 name_version_pairs  :: { [LocalVersion OccName] }
 name_version_pairs  :                                                  { [] }
                    |  name_version_pair name_version_pairs     { $1 : $2 }
 
 name_version_pair   :: { LocalVersion OccName }
-name_version_pair   :  entity_occ INTEGER                      { ($1, fromInteger $2)
+name_version_pair   :  var_occ INTEGER                         { ($1, fromInteger $2) }
+                    |  tc_occ  INTEGER                          { ($1, fromInteger $2) }
+
+
 --------------------------------------------------------------------------
-                                                               }
 
 exports_part   :: { [ExportItem] }
-exports_part   :  EXPORTS_PART export_items                    { $2 }
-               |                                               { [] }
-
-export_items   :: { [ExportItem] }
-export_items   :                                               { [] }
-               |  mod_name entities SEMI export_items          { ($1,$2) : $4 }
+exports_part   :                                       { [] }
+               | exports_part '__export' 
+                 mod_fs entities ';'                   { (mkSysModuleFS $3, $4) : $1 }
 
-entities       :: { [(OccName, [OccName])] }
-entities       :                                               { [] }
-               |  entity entities                              { $1 : $2 }
+entities       :: { [RdrAvailInfo] }
+entities       :                                       { [] }
+               |  entity entities                      { $1 : $2 }
 
-entity         :: { (OccName, [OccName]) }
-entity         :  entity_occ                                   { ($1, if isTCOcc $1 
-                                                                      then [$1]  {- AvailTC -}
-                                                                      else [])   {- Avail -} }
-               |  entity_occ stuff_inside                      { ($1, ($1 : $2)) {- TyCls exported too -} }
-               |  entity_occ BANG stuff_inside                 { ($1, $3)        {- TyCls not exported -} }
+entity         :: { RdrAvailInfo }
+entity         :  tc_occ                               { AvailTC $1 [$1] }
+               |  var_occ                              { Avail $1 }
+               |  tc_occ stuff_inside                  { AvailTC $1 ($1:$2) }
+               |  tc_occ '|' stuff_inside              { AvailTC $1 $3 }
 
 stuff_inside   :: { [OccName] }
-stuff_inside   :  OPAREN val_occs1 CPAREN                      { $2
---------------------------------------------------------------------------
-                                                               }
+stuff_inside   :  '{' val_occs '}'                     { $2 }
+
+val_occ                :: { OccName }
+               :  var_occ              { $1 }
+                |  data_occ             { $1 }
+
+val_occs       :: { [OccName] }
+               :  val_occ              { [$1] }
+               |  val_occ val_occs     { $1 : $2 }
 
-inst_modules_part :: { [Module] }
-inst_modules_part :                                            { [] }
-                 |  INSTANCE_MODULES_PART mod_list             { $2 }
 
-mod_list       :: { [Module] }
-mod_list       :                                               { [] }
-               |  mod_name mod_list                            { $1 : $2
 --------------------------------------------------------------------------
-                                                                 }
 
-fixities_part  :: { [(OccName,Fixity)] }
-fixities_part  :                                               { [] }
-               |  FIXITIES_PART fixes                          { $2 }
+fixity      :: { FixityDirection }
+fixity      : 'infixl'                                  { InfixL }
+            | 'infixr'                                  { InfixR }
+            | 'infix'                                   { InfixN }
+   
+mb_fix      :: { Int }
+mb_fix     : {-nothing-}                               { 9 }
+           | INTEGER                                   { (fromInteger $1) }
+
+-----------------------------------------------------------------------------
 
-fixes          :: { [(OccName,Fixity)] }
-fixes          :                                               { []  }
-               |  fix fixes                                    { $1 : $2 }
+csigs          :: { [RdrNameSig] }
+csigs          :                               { [] }
+               | 'where' '{' csigs1 '}'        { $3 }
+
+csigs1         :: { [RdrNameSig] }
+csigs1         : csig                          { [$1] }
+               | 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 }
 
-fix            :: { (OccName, Fixity) }
-fix            :  INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
-               |  INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
-               |  INFIX  INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
 --------------------------------------------------------------------------
-                                                                                     }
 
-decls_part     :: { [(Version, RdrNameHsDecl)] }
-decls_part     :                                       { [] }
-               |       DECLARATIONS_PART topdecls      { $2 }
+instance_decl_part :: { [RdrNameInstDecl] }
+instance_decl_part : {- empty -}                      { [] }
+                  | instance_decl_part inst_decl      { $2 : $1 }
+
+inst_decl      :: { RdrNameInstDecl }
+inst_decl      :  src_loc 'instance' type '=' var_name ';'
+                       { InstDecl $3
+                                  EmptyMonoBinds       {- No bindings -}
+                                  []                   {- No user pragmas -}
+                                  $5                   {- Dfun id -}
+                                  $1
+                       }
+
+--------------------------------------------------------------------------
 
-topdecls       :: { [(Version, RdrNameHsDecl)] }
-topdecls       :                                       { [] }
-               |  version topdecl topdecls             { ($1,$2) : $3 }
+decls_part :: { [(Version, RdrNameHsDecl)] }
+decls_part 
+       :  {- empty -}                          { [] }
+       |  decls_part version decl ';'          { ($2,$3):$1 }
+
+decl   :: { RdrNameHsDecl }
+decl    : src_loc var_name '::' type maybe_idinfo
+                        { SigD (IfaceSig $2 $4 ($5 $2) $1) }
+       | src_loc 'type' tc_name tv_bndrs '=' type                     
+                       { TyClD (TySynonym $3 $4 $6 $1) }
+       | src_loc 'data' decl_context tc_name tv_bndrs constrs         
+                       { TyClD (TyData DataType $3 $4 $5 $6 Nothing noDataPragmas $1) }
+       | src_loc 'newtype' decl_context tc_name tv_bndrs newtype_constr
+                       { TyClD (TyData NewType $3 $4 $5 $6 Nothing noDataPragmas $1) }
+       | src_loc 'class' decl_context tc_name tv_bndrs csigs
+                       { TyClD (mkClassDecl $3 $4 $5 $6 EmptyMonoBinds 
+                                       noClassPragmas $1) }
+        | src_loc fixity mb_fix var_or_data_name
+                        { FixD (FixitySig $4 (Fixity $3 $2) $1) }
+
+maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
+maybe_idinfo  : {- empty -}    { \_ -> [] }
+             | src_loc PRAGMA  { \x -> 
+                                  case parseIface $2
+                                          PState{bol = 0#, atbol = 1#,
+                                                 context = [],
+                                                 glasgow_exts = 1#,
+                                                 loc = $1 } of
+                                    POk _ (PIdInfo id_info) -> id_info
+                                    PFailed err -> 
+                                       pprPanic "IdInfo parse failed" 
+                                           (vcat [ppr x, err])
+                               }
+
+-----------------------------------------------------------------------------
+
+rules_part :: { [RdrNameRuleDecl] }
+rules_part : {- empty -}       { [] }
+          | src_loc PRAGMA     { case parseIface $2 
+                                          PState{bol = 0#, atbol = 1#,
+                                                 context = [],
+                                                 glasgow_exts = 1#,
+                                                 loc = $1 }  of
+                                    POk _ (PRules rules) -> rules
+                                    PFailed err -> 
+                                         pprPanic "Rules parse failed" err
+                               }
+
+rules     :: { [RdrNameRuleDecl] }
+          : {- empty -}        { [] }
+          | rule ';' rules     { $1:$3 }
+
+rule      :: { RdrNameRuleDecl }
+rule      : src_loc STRING rule_forall qvar_name 
+            core_args '=' core_expr    { IfaceRuleDecl $4 (UfRuleBody $2 $3 $5 $7) $1 } 
+
+rule_forall    :: { [UfBinder RdrName] }
+rule_forall    : '__forall' '{' core_bndrs '}' { $3 }
+                 
+-----------------------------------------------------------------------------
 
 version                :: { Version }
 version                :  INTEGER                              { fromInteger $1 }
 
-topdecl                :: { RdrNameHsDecl }
-topdecl                :  TYPE  tc_name tv_bndrs EQUAL type SEMI
-                       { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
-               |  DATA decl_context tc_name tv_bndrs constrs deriving SEMI
-                       { TyD (TyData DataType $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
-               |  NEWTYPE decl_context tc_name tv_bndrs newtype_constr deriving SEMI
-                       { TyD (TyData NewType $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
-               |  CLASS decl_context tc_name tv_bndr csigs SEMI
-                       { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
-               |  var_name TYPE_PART id_info
-                       {
-                        let
-                         (Succeeded tp) = parseType $2
-                        in
-                        SigD (IfaceSig $1 tp $3 mkIfaceSrcLoc) }
-
-id_info        :: { [HsIdInfo RdrName] }
-id_info                :                               { [] }
-               | IDINFO_PART   { let { (Succeeded id_info) = parseUnfolding $1 } in id_info}
-
 decl_context   :: { RdrNameContext }
 decl_context   :                                       { [] }
-               | OCURLY context_list1 CCURLY DARROW    { $2 }
-
-
-csigs          :: { [RdrNameSig] }
-csigs          :                               { [] }
-               | WHERE OCURLY csigs1 CCURLY    { $3 }
-
-csigs1         :: { [RdrNameSig] }
-csigs1         : csig                          { [$1] }
-               | csig SEMI csigs1              { $1 : $3 }
+               | '{' context_list1 '}' '=>'    { $2 }
 
-csig           :: { RdrNameSig }
-csig           :  var_name DCOLON type         { ClassOpSig $1 $1 $3 mkIfaceSrcLoc
-----------------------------------------------------------------
-                                                }
+----------------------------------------------------------------------------
 
 constrs                :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
-               :                               { [] }
-               | EQUAL constrs1                { $2 }
+               :                       { [] }
+               | '=' constrs1          { $2 }
 
 constrs1       :: { [RdrNameConDecl] }
 constrs1       :  constr               { [$1] }
-               |  constr VBAR constrs1 { $1 : $3 }
+               |  constr '|' constrs1  { $1 : $3 }
 
 constr         :: { RdrNameConDecl }
-constr         :  data_name batypes                    { ConDecl $1 [] (VanillaCon $2) mkIfaceSrcLoc }
-               |  data_name OCURLY fields1 CCURLY      { ConDecl $1 [] (RecCon $3)     mkIfaceSrcLoc }
+constr         :  src_loc ex_stuff data_name batypes           { mkConDecl $3 $2 (VanillaCon $4) $1 }
+               |  src_loc ex_stuff data_name '{' fields1 '}'   { mkConDecl $3 $2 (RecCon $5)     $1 }
+                -- We use "data_fs" so as to include ()
 
 newtype_constr :: { [RdrNameConDecl] {- Empty if handwritten abstract -} }
-newtype_constr :                               { [] }
-               | EQUAL data_name atype         { [ConDecl $2 [] (NewCon $3) mkIfaceSrcLoc] }
+newtype_constr :                                       { [] }
+               | src_loc '=' ex_stuff data_name atype  { [mkConDecl $4 $3 (NewCon $5 Nothing) $1] }
+               | src_loc '=' ex_stuff data_name '{' var_name '::' atype '}'
+                                                       { [mkConDecl $4 $3 (NewCon $8 (Just $6)) $1] }
 
-deriving       :: { Maybe [RdrName] }
-               :                                       { Nothing }
-               | DERIVING OPAREN tc_names1 CPAREN      { Just $3 }
+ex_stuff :: { ([HsTyVar RdrName], RdrNameContext) }
+ex_stuff       :                                       { ([],[]) }
+                | '__forall' forall context '=>'            { ($2,$3) }
 
 batypes                :: { [RdrNameBangType] }
 batypes                :                                       { [] }
@@ -289,159 +387,403 @@ batypes         :                                       { [] }
 
 batype         :: { RdrNameBangType }
 batype         :  atype                                { Unbanged $1 }
-               |  BANG atype                           { Banged   $2 }
+               |  '!' atype                            { Banged   $2 }
+               |  '!' '!' atype                        { Unpacked $3 }
 
 fields1                :: { [([RdrName], RdrNameBangType)] }
 fields1                : field                                 { [$1] }
-               | field COMMA fields1                   { $1 : $3 }
+               | field ',' fields1                     { $1 : $3 }
 
 field          :: { ([RdrName], RdrNameBangType) }
-field          :  var_names1 DCOLON type               { ($1, Unbanged $3) }
-               |  var_names1 DCOLON BANG type          { ($1, Banged   $4)
+field          :  var_names1 '::' type         { ($1, Unbanged $3) }
+               |  var_names1 '::' '!' type     { ($1, Banged   $4) }
+               |  var_names1 '::' '!' '!' type { ($1, Unpacked $5) }
 --------------------------------------------------------------------------
-                                                       }
+
+type           :: { RdrNameHsType }
+type           : '__fuall'  fuall '=>' type    { mkHsUsForAllTy $2 $4 }
+                | '__forall' forall context '=>' type  
+                                               { mkHsForAllTy $2 $3 $5 }
+               | btype '->' type               { MonoFunTy $1 $3 }
+               | btype                         { $1 }
+
+fuall          :: { [RdrName] }
+fuall          : '[' uv_bndrs ']'                      { $2 }
 
 forall         :: { [HsTyVar RdrName] }
-forall         : OBRACK tv_bndrs CBRACK                { $2 }
+forall         : '[' tv_bndrs ']'                      { $2 }
 
 context                :: { RdrNameContext }
 context                :                                       { [] }
-               | OCURLY context_list1 CCURLY           { $2 }
+               | '{' context_list1 '}'                 { $2 }
 
 context_list1  :: { RdrNameContext }
 context_list1  : class                                 { [$1] }
-               | class COMMA context_list1             { $1 : $3 }
-
-class          :: { (RdrName, RdrNameHsType) }
-class          :  tc_name atype                        { ($1, $2) }
+               | class ',' context_list1               { $1 : $3 }
 
-type           :: { RdrNameHsType }
-type           : FORALL forall context DARROW type     { mkHsForAllTy $2 $3 $5 }
-               |  btype RARROW type                    { MonoFunTy $1 $3 }
-               |  btype                                { $1 }
+class          :: { (RdrName, [RdrNameHsType]) }
+class          :  qcls_name atypes                     { ($1, $2) }
 
 types2         :: { [RdrNameHsType]                    {- Two or more -}  }    
-types2         :  type COMMA type                      { [$1,$3] }
-               |  type COMMA types2                    { $1 : $3 }
+types2         :  type ',' type                        { [$1,$3] }
+               |  type ',' types2                      { $1 : $3 }
 
 btype          :: { RdrNameHsType }
 btype          :  atype                                { $1 }
                |  btype atype                          { MonoTyApp $1 $2 }
+                |  '__u' usage atype                   { MonoUsgTy $2 $3 }
+
+usage          :: { MonoUsageAnn RdrName }
+usage          : '-'                                   { MonoUsOnce }
+               | '!'                                   { MonoUsMany }
+               | uv_name                               { MonoUsVar $1 }
 
 atype          :: { RdrNameHsType }
-atype          :  tc_name                              { MonoTyVar $1 }
+atype          :  qtc_name                             { MonoTyVar $1 }
                |  tv_name                              { MonoTyVar $1 }
-               |  OPAREN types2 CPAREN                 { MonoTupleTy dummyRdrTcName $2 }
-               |  OBRACK type CBRACK                   { MonoListTy  dummyRdrTcName $2 }
-               |  OCURLY tc_name atype CCURLY          { MonoDictTy $2 $3 }
-               |  OPAREN type CPAREN                   { $2 }
+               |  '(' types2 ')'                       { MonoTupleTy $2 True{-boxed-} }
+               |  '(#' type '#)'                       { MonoTupleTy [$2] False{-unboxed-} }
+               |  '(#' types2 '#)'                     { MonoTupleTy $2 False{-unboxed-} }
+               |  '[' type ']'                         { MonoListTy  $2 }
+               |  '{' qcls_name atypes '}'             { MonoDictTy $2 $3 }
+               |  '(' type ')'                         { $2 }
+
+-- This one is dealt with via qtc_name
+--             |  '(' ')'                              { MonoTupleTy [] True }
 
 atypes         :: { [RdrNameHsType]    {-  Zero or more -} }
 atypes         :                                       { [] }
-               |  atype atypes                         { $1 : $2
+               |  atype atypes                         { $1 : $2 }
 ---------------------------------------------------------------------
-                                                       }
-
-mod_name       :: { Module }
+mod_fs         :: { EncodedFS }
                :  CONID                { $1 }
 
-var_occ                :: { OccName }
-var_occ                : VARID                 { VarOcc $1 }
-               | VARSYM                { VarOcc $1 }
-               | BANG                  { VarOcc SLIT("!") {-sigh, double-sigh-} }
+mod_name       :: { ModuleName }
+               :  mod_fs               { mkSysModuleFS $1 }
 
-tc_occ         :: { OccName }
-tc_occ         :  CONID                { TCOcc $1 }
-               |  CONSYM               { TCOcc $1 }
-               |  OPAREN RARROW CPAREN { TCOcc SLIT("->") }
 
-entity_occ     :: { OccName }
-entity_occ     :  var_occ              { $1 }
-               |  tc_occ               { $1 }
-               |  RARROW               { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
+---------------------------------------------------
+var_fs         :: { EncodedFS }
+               : VARID                 { $1 }
+               | VARSYM                { $1 }
+               | '!'                   { SLIT("!") }
+               | '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") }
 
-val_occ                :: { OccName }
-val_occ                :  var_occ              { $1 }
-               |  CONID                { VarOcc $1 }
-               |  CONSYM               { VarOcc $1 }
+qvar_fs                :: { (EncodedFS, EncodedFS) }
+               :  QVARID               { $1 }
+               |  QVARSYM              { $1 }
 
-val_occs1      :: { [OccName] }
-               :  val_occ              { [$1] }
-               |  val_occ val_occs1    { $1 : $2 }
+var_occ                :: { OccName }
+               :  var_fs               { mkSysOccFS varName $1 }
 
+var_name       :: { RdrName }
+var_name       :  var_occ              { mkRdrUnqual $1 }
 
 qvar_name      :: { RdrName }
-               :  QVARID               { varQual $1 }
-               |  QVARSYM              { varQual $1 }
+qvar_name      :  var_name             { $1 }
+               |  qvar_fs              { mkSysQual varName $1 }
 
-var_name       :: { RdrName }
-var_name       :  var_occ              { Unqual $1 }
+var_names      :: { [RdrName] }
+var_names      :                       { [] }
+               | var_name var_names    { $1 : $2 }
 
 var_names1     :: { [RdrName] }
-var_names1     : var_name              { [$1] }
-               | var_name var_names1   { $1 : $2 }
+var_names1     : var_name var_names    { $1 : $2 }
 
-any_var_name   :: {RdrName}
-any_var_name   :  var_name             { $1 }
-               |  qvar_name            { $1 }
+---------------------------------------------------
+-- For some bizarre reason, 
+--      (,,,)      is dealt with by the parser
+--      Foo.(,,,)  is dealt with by the lexer
+-- Sigh
 
-qdata_name     :: { RdrName }
-qdata_name     :  QCONID               { varQual $1 }
-               |  QCONSYM              { varQual $1 }
+data_fs                :: { EncodedFS }
+               :  CONID                { $1 }
+               |  CONSYM               { $1 }
+
+qdata_fs       :: { (EncodedFS, EncodedFS) }
+                :  QCONID              { $1 }
+                |  QCONSYM             { $1 }
+
+data_occ       :: { OccName }
+               :  data_fs              { mkSysOccFS dataName $1 }
 
 data_name      :: { RdrName }
-data_name      :  CONID                { Unqual (VarOcc $1) }
-               |  CONSYM               { Unqual (VarOcc $1) }
+                :  data_occ             { mkRdrUnqual $1 }
+
+qdata_name     :: { RdrName }
+qdata_name     :  data_name            { $1 }
+               |  qdata_fs             { mkSysQual dataName $1 }
+                               
+qdata_names    :: { [RdrName] }
+qdata_names    :                               { [] }
+               | qdata_name qdata_names        { $1 : $2 }
 
+var_or_data_name :: { RdrName }
+                  : var_name                    { $1 }
+                  | data_name                   { $1 }
 
-tc_names1      :: { [RdrName] }
-               : tc_name                       { [$1] }
-               | tc_name COMMA tc_names1       { $1 : $3 }
+---------------------------------------------------
+tc_fs           :: { EncodedFS }
+                :  data_fs              { $1 }
+
+tc_occ         :: { OccName }
+               :  tc_fs                { mkSysOccFS tcName $1 }
 
 tc_name                :: { RdrName }
-tc_name                : tc_occ                        { Unqual $1 }
-               | QCONID                        { tcQual $1 }
+                :  tc_occ              { mkRdrUnqual $1 }
 
-tv_name                :: { RdrName }
-tv_name                :  VARID                { Unqual (TvOcc $1) }
+qtc_name       :: { RdrName }
+                : tc_name              { $1 }
+               | qdata_fs              { mkSysQual tcName $1 }
+
+---------------------------------------------------
+cls_name       :: { RdrName }
+               :  data_fs              { mkSysUnqual clsName $1 }
+
+qcls_name      :: { RdrName }
+               : cls_name              { $1 }
+               | qdata_fs              { mkSysQual clsName $1 }
+
+---------------------------------------------------
+uv_name                :: { RdrName }
+               :  VARID                { mkSysUnqual uvName $1 }
+
+uv_bndr                :: { RdrName }
+               :  uv_name              { $1 }
 
-tv_names       :: { [RdrName] }
+uv_bndrs       :: { [RdrName] }
                :                       { [] }
-               | tv_name tv_names      { $1 : $2 }
+               | uv_bndr uv_bndrs      { $1 : $2 }
+
+---------------------------------------------------
+tv_name                :: { RdrName }
+               :  VARID                { mkSysUnqual tvName $1 }
+               |  VARSYM               { mkSysUnqual tvName $1 {- Allow t2 as a tyvar -} }
 
 tv_bndr                :: { HsTyVar RdrName }
-tv_bndr                :  tv_name DCOLON akind { IfaceTyVar $1 $3 }
-               |  tv_name              { UserTyVar $1 }
+               :  tv_name '::' akind   { IfaceTyVar $1 $3 }
+               |  tv_name              { IfaceTyVar $1 boxedTypeKind }
 
 tv_bndrs       :: { [HsTyVar RdrName] }
                :                       { [] }
                | tv_bndr tv_bndrs      { $1 : $2 }
 
+---------------------------------------------------
 kind           :: { Kind }
                : akind                 { $1 }
-               | akind RARROW kind     { mkArrowKind $1 $3 }
+               | akind '->' kind       { mkArrowKind $1 $3 }
 
 akind          :: { Kind }
-               : VARSYM                { mkBoxedTypeKind {- ToDo: check that it's "*" -} }
-               | OPAREN kind CPAREN    { $2
---------------------------------------------------------------------------
+               : VARSYM                { if $1 == SLIT("*") then
+                                               boxedTypeKind
+                                         else if $1 == SLIT("?") then
+                                               openTypeKind
+                                         else panic "ParseInterface: akind"
                                        }
+               | '(' kind ')'  { $2 }
 
+--------------------------------------------------------------------------
 
-instances_part :: { [RdrNameInstDecl] }
-instances_part :  INSTANCES_PART instdecls { $2 }
-               |                           { [] }
+id_info                :: { [HsIdInfo RdrName] }
+               :                               { [] }
+               | id_info_item id_info          { $1 : $2 }
+
+id_info_item   :: { HsIdInfo RdrName }
+               : '__A' INTEGER                 { HsArity (exactArity (fromInteger $2)) }
+               | '__U' core_expr               { HsUnfold $1 (Just $2) }
+                | '__U'                        { HsUnfold $1 Nothing }
+               | '__M'                         { HsCprInfo $1 }
+               | '__S'                         { HsStrictness (HsStrictnessInfo $1) }
+               | '__C'                         { HsNoCafRefs }
+               | '__P' qvar_name               { HsWorker $2 }
+
+-------------------------------------------------------
+core_expr      :: { UfExpr RdrName }
+core_expr      : '\\' core_bndrs '->' core_expr        { foldr UfLam $4 $2 }
+               | 'case' core_expr 'of' var_name
+                 '{' core_alts '}'                     { UfCase $2 $4 $6 }
+
+               | 'let' '{' core_val_bndr '=' core_expr
+                     '}' 'in' core_expr                { UfLet (UfNonRec $3 $5) $8 }
+               | '__letrec' '{' rec_binds '}'          
+                 'in' core_expr                        { UfLet (UfRec $3) $6 }
+
+               | con_or_primop '{' core_args '}'       { UfCon $1 $3 }
+                | '__litlit' STRING atype               { UfCon (UfLitLitCon $2 $3) [] }
+
+                | '__inline_me' core_expr               { UfNote UfInlineMe $2 }
+                | '__inline_call' core_expr             { UfNote UfInlineCall $2 }
+                | '__coerce' atype core_expr            { UfNote (UfCoerce $2) $3 }
+               | scc core_expr                         { UfNote (UfSCC $1) $2  }
+               | fexpr                                 { $1 }
+
+fexpr   :: { UfExpr RdrName }
+fexpr   : fexpr core_arg                               { UfApp $1 $2 }
+        | core_aexpr                                   { $1 }
+
+core_arg       :: { UfExpr RdrName }
+               : '@' atype                                     { UfType $2 }
+                | core_aexpr                                    { $1 }
+
+core_args      :: { [UfExpr RdrName] }
+               :                                               { [] }
+               | core_arg core_args                            { $1 : $2 }
+
+core_aexpr      :: { UfExpr RdrName }              -- Atomic expressions
+core_aexpr      : qvar_name                                    { UfVar $1 }
+
+                | qdata_name                                    { UfVar $1 }
+                       -- This one means that e.g. "True" will parse as 
+                       -- (UfVar True_Id) rather than (UfCon True_Con []).
+                       -- No big deal; it'll be inlined in a jiffy.  I tried 
+                       -- parsing it to (Con con []) directly, but got bitten 
+                       -- when a real constructor Id showed up in an interface
+                       -- file.  As usual, a hack bites you in the end.
+                       -- If you want to get a UfCon, then use the
+                       -- curly-bracket notation (True {}).
+
+               | core_lit               { UfCon (UfLitCon $1) [] }
+               | '(' core_expr ')'      { $2 }
+               | '(' comma_exprs2 ')'   { UfTuple (mkTupConRdrName (length $2)) $2 }
+               | '(#' core_expr '#)'    { UfTuple (mkUbxTupConRdrName 1) [$2] }
+               | '(#' comma_exprs2 '#)' { UfTuple (mkUbxTupConRdrName (length $2)) $2 }
+
+-- This one is dealt with by qdata_name: see above comments
+--             | '('  ')'               { UfTuple (mkTupConRdrName 0) [] }
+
+comma_exprs2   :: { [UfExpr RdrName] } -- Two or more
+comma_exprs2   : core_expr ',' core_expr                       { [$1,$3] }
+               | core_expr ',' comma_exprs2                    { $1 : $3 }
+
+con_or_primop   :: { UfCon RdrName }
+con_or_primop   : qdata_name                    { UfDataCon $1 }
+                | qvar_name                    { UfPrimOp $1 }
+                | '__ccall' ccall_string      { let
+                                               (is_dyn, is_casm, may_gc) = $1
+                                               in
+                                               UfCCallOp $2 is_dyn is_casm may_gc
+                                               }
+
+rec_binds      :: { [(UfBinder RdrName, UfExpr RdrName)] }
+               :                                               { [] }
+               | core_val_bndr '=' core_expr ';' rec_binds     { ($1,$3) : $5 }
+
+core_alts      :: { [UfAlt RdrName] }
+               : core_alt                                      { [$1] }
+               | core_alt ';' core_alts                        { $1 : $3 }
+
+core_alt        :: { UfAlt RdrName }
+core_alt       : core_pat '->' core_expr       { (fst $1, snd $1, $3) }
+
+core_pat       :: { (UfCon RdrName, [RdrName]) }
+core_pat       : core_lit                      { (UfLitCon  $1, []) }
+               | '__litlit' STRING atype       { (UfLitLitCon $2 $3, []) }
+               | qdata_name var_names          { (UfDataCon $1, $2) }
+               | '(' comma_var_names1 ')'      { (UfDataCon (mkTupConRdrName (length $2)), $2) }
+               | '(#' comma_var_names1 '#)'    { (UfDataCon (mkUbxTupConRdrName (length $2)), $2) }
+               | '__DEFAULT'                   { (UfDefault, []) }
+               | '(' core_pat ')'              { $2 }
+
+
+comma_var_names1 :: { [RdrName] }      -- One or more
+comma_var_names1 : var_name                                    { [$1] }
+                | var_name ',' comma_var_names1                { $1 : $3 }
+
+core_lit       :: { Literal }
+core_lit       : integer                       { mkMachInt_safe $1 }
+               | CHAR                          { MachChar $1 }
+               | STRING                        { MachStr $1 }
+               | '__string' STRING             { NoRepStr $2 (panic "NoRepStr type") }
+               | rational                      { MachDouble $1 }
+               | '__float' rational            { MachFloat $2 }
+
+               | '__integer' integer           { NoRepInteger  $2 (panic "NoRepInteger type") 
+                                                       -- The type checker will add the types
+                                               }
+
+               | '__rational' integer integer  { NoRepRational ($2 % $3) 
+                                                  (panic "NoRepRational type")
+                                                       -- The type checker will add the type
+                                               }
+
+               | '__addr' integer              { MachAddr $2 }
+
+integer                :: { Integer }
+               : INTEGER                       { $1 }
+               | '-' INTEGER                   { (-$2) }
+
+rational       :: { Rational }
+               : RATIONAL                      { $1 }
+               | '-' RATIONAL                  { (-$2) }
+
+core_bndr       :: { UfBinder RdrName }
+core_bndr       : core_val_bndr                                 { $1 }
+                | core_tv_bndr                                  { $1 }
+
+core_bndrs     :: { [UfBinder RdrName] }
+core_bndrs     :                                               { [] }
+               | core_bndr core_bndrs                          { $1 : $2 }
+
+core_val_bndr  :: { UfBinder RdrName }
+core_val_bndr  : var_name '::' atype                           { UfValBinder $1 $3 }
+
+core_tv_bndr   :: { UfBinder RdrName }
+core_tv_bndr   :  '@' tv_name '::' akind               { UfTyBinder $2 $4 }
+               |  '@' tv_name                          { UfTyBinder $2 boxedTypeKind }
+
+ccall_string   :: { FAST_STRING }
+               : STRING                                        { $1 }
+               | CLITLIT                                       { $1 }
+               | VARID                                         { $1 }
+               | CONID                                         { $1 }
+
+------------------------------------------------------------------------
+scc     :: { CostCentre }
+        :  '__sccC' '{' mod_name STRING '}'                      { AllCafsCC $3 $4 }
+        |  '__scc' '{' cc_name mod_name STRING cc_dup cc_caf '}'
+                             { NormalCC { cc_name = $3, cc_mod = $4, cc_grp = $5,
+                                          cc_is_dupd = $6, cc_is_caf = $7 } }
+
+cc_name :: { EncodedFS }
+        : CONID                 { $1 }
+        | VARID                 { $1 }
+  
+cc_dup  :: { IsDupdCC }
+cc_dup  :                       { OriginalCC }
+        | '!'                   { DupdCC }
+
+cc_caf  :: { IsCafCC }
+        :                       { NotCafCC }
+        | '__C'                 { CafCC }
+
+-------------------------------------------------------------------
+
+src_loc :: { SrcLoc }
+src_loc :                              {% getSrcLocP }
+
+checkVersion :: { () }
+          : {-empty-}                  {% checkVersion Nothing }
+          | INTEGER                    {% checkVersion (Just (fromInteger $1)) }
+
+------------------------------------------------------------------- 
+
+--                     Haskell code 
+{
+happyError :: P a
+happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
 
-instdecls      :: { [RdrNameInstDecl] }
-instdecls      :                           { [] }
-               |  instd instdecls          { $1 : $2 }
+data IfaceStuff = PIface       EncodedFS{-.hi module name-} ParsedIface
+               | PIdInfo       [HsIdInfo RdrName]
+               | PType         RdrNameHsType
+               | PRules        [RdrNameRuleDecl]
 
-instd          :: { RdrNameInstDecl }
-instd          :  INSTANCE type EQUAL var_name SEMI 
-                       { InstDecl $2
-                                  EmptyMonoBinds       {- No bindings -}
-                                  []                   {- No user pragmas -}
-                                  (Just $4)            {- Dfun id -}
-                                  mkIfaceSrcLoc 
---------------------------------------------------------------------------
-                   }
+mkConDecl name (ex_tvs, ex_ctxt) details loc = ConDecl name ex_tvs ex_ctxt details loc
+}