[project @ 2000-02-25 14:55:31 by panne]
[ghc-hetmet.git] / ghc / compiler / rename / ParseIface.y
index bcf592d..f821b31 100644 (file)
@@ -5,8 +5,7 @@ module ParseIface ( parseIface, IfaceStuff(..) ) where
 
 import HsSyn           -- quite a bit of stuff
 import RdrHsSyn                -- oodles of synonyms
-import HsDecls         ( HsIdInfo(..), HsStrictnessInfo(..) )
-import HsTypes         ( mkHsForAllTy )
+import HsTypes         ( mkHsForAllTy, mkHsUsForAllTy )
 import HsCore
 import Const           ( Literal(..), mkMachInt_safe )
 import BasicTypes      ( Fixity(..), FixityDirection(..), 
@@ -14,22 +13,22 @@ import BasicTypes   ( Fixity(..), FixityDirection(..),
                        )
 import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
 import HsPragmas       ( noDataPragmas, noClassPragmas )
-import Type            ( Kind, mkArrowKind, boxedTypeKind, openTypeKind )
-import IdInfo           ( ArityInfo, exactArity )
+import Type            ( Kind, mkArrowKind, boxedTypeKind, openTypeKind, UsageAnn(..) )
+import IdInfo           ( ArityInfo, exactArity, CprInfo(..), InlinePragInfo(..) )
 import Lex             
 
 import RnMonad         ( ImportVersion, LocalVersion, ParsedIface(..), WhatsImported(..),
-                         RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..)
+                         RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..), WhetherHasOrphans
                        ) 
 import Bag             ( emptyBag, unitBag, snocBag )
 import FiniteMap       ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
 import RdrName          ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual )
 import Name            ( OccName, Provenance )
 import OccName          ( mkSysOccFS,
-                         tcName, varName, dataName, clsName, tvName,
+                         tcName, varName, ipName, dataName, clsName, tvName, uvName,
                          EncodedFS 
                        )
-import Module           ( Module, mkSysModuleFS, IfaceFlavour, hiFile, hiBootFile )                    
+import Module           ( ModuleName, mkSysModuleFS )                  
 import PrelMods         ( mkTupNameStr, mkUbxTupNameStr )
 import PrelInfo         ( mkTupConRdrName, mkUbxTupConRdrName )
 import SrcLoc          ( SrcLoc )
@@ -44,9 +43,9 @@ import Ratio ( (%) )
 }
 
 %name      parseIface
-%tokentype  { IfaceToken }
-%monad     { IfM }{ thenIf }{ returnIf }
-%lexer      { lexIface } { ITeof }
+%tokentype  { Token }
+%monad     { P }{ thenP }{ returnP }
+%lexer      { lexer } { ITeof }
 
 %token
  'case'        { ITcase }                      -- Haskell keywords
@@ -74,13 +73,22 @@ import Ratio ( (%) )
  'qualified'   { ITqualified }
  'hiding'      { IThiding }
 
- '__interface' { ITinterface }                 -- GHC-extension keywords
- '__export'    { ITexport }
- '__instimport'        { ITinstimport }
- '__forall'    { ITforall }
+ 'forall'      { ITforall }                    -- GHC extension keywords
+ 'foreign'     { ITforeign }
+ 'export'      { ITexport }
+ 'label'       { ITlabel } 
+ 'dynamic'     { ITdynamic }
+ 'unsafe'      { ITunsafe }
+ 'with'                { ITwith }
+
+ '__interface' { ITinterface }                 -- interface keywords
+ '__export'    { IT__export }
+ '__forall'    { IT__forall }
+ '__depends'   { ITdepends }
  '__letrec'    { ITletrec }
  '__coerce'    { ITcoerce }
- '__inline'    { ITinline }
+ '__inline_call'{ ITinlineCall }
+ '__inline_me'  { ITinlineMe }
  '__DEFAULT'   { ITdefaultbranch }
  '__bot'       { ITbottom }
  '__integer'   { ITinteger_lit }
@@ -93,11 +101,17 @@ import Ratio ( (%) )
  '__scc'       { ITscc }
  '__sccC'       { ITsccAllCafs }
 
+ '__u'         { ITusage }
+ '__fuall'     { ITfuall }
+
  '__A'         { ITarity }
  '__P'         { ITspecialise }
  '__C'         { ITnocaf }
  '__U'         { ITunfold $$ }
  '__S'         { ITstrict $$ }
+ '__R'         { ITrules }
+ '__D'         { ITdeprecated }
+ '__M'         { ITcprinfo $$ }
 
  '..'          { ITdotdot }                    -- reserved symbols
  '::'          { ITdcolon }
@@ -134,12 +148,15 @@ import Ratio ( (%) )
  QVARSYM       { ITqvarsym  $$ }
  QCONSYM       { ITqconsym  $$ }
 
+ IPVARID       { ITipvarid  $$ }               -- GHC extension
+
  PRAGMA                { ITpragma   $$ }
 
  CHAR          { ITchar     $$ }
  STRING                { ITstring   $$ }
  INTEGER       { ITinteger  $$ }
  RATIONAL      { ITrational $$ }
+ CLITLIT       { ITlitlit   $$ }
 
  UNKNOWN       { ITunknown  $$ }
 %%
@@ -151,27 +168,30 @@ import Ratio ( (%) )
 
 iface_stuff :: { IfaceStuff }
 iface_stuff : iface            { let (nm, iff) = $1 in PIface nm iff }
-           | type              { PType   $1 }
-           | id_info           { PIdInfo $1 }
+           | type              { PType    $1 }
+           | id_info           { PIdInfo  $1 }
+           | '__R' rules       { PRules   $2 }
+           | '__D' deprecs     { PDeprecs $2 }
 
 
-iface          :: { (EncodedFS, ParsedIface) }
-iface          : '__interface' mod_fs INTEGER checkVersion 'where'
-                  import_part
-                 instance_import_part
+iface          :: { (ModuleName, ParsedIface) }
+iface          : '__interface' mod_fs INTEGER orphans checkVersion 'where'
                  exports_part
+                  import_part
                  instance_decl_part
                  decls_part
+                 rules_and_deprecs
                  { ( $2                        -- Module name
-                   , ParsedIface 
-                       (fromInteger $3)        -- Module version
-                       (reverse $6)            -- Usages
-                       (reverse $8)            -- Exports
-                       (reverse $7)            -- Instance import modules
-                       (reverse $10)           -- Decls
-                       (reverse $9)            -- Local instances
-                   )
-                 }
+                   , 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   = fst $11,   -- Rules 
+                       pi_deprecs = snd $11    -- Deprecations 
+                     } ) }
 
 --------------------------------------------------------------------------
 
@@ -180,12 +200,19 @@ import_part :                                               { [] }
            |  import_part import_decl                    { $2 : $1 }
            
 import_decl :: { ImportVersion OccName }
-import_decl : 'import' mod_fs opt_bang INTEGER '::' whats_imported ';'
-                       { (mkSysModuleFS $2 $3, fromInteger $4, $6) }
+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_pair name_version_pairs      { Specifically ($1:$2) }
+                    | '::' name_version_pairs                  { Specifically $2 }
 
 name_version_pairs  :: { [LocalVersion OccName] }
 name_version_pairs  :                                                  { [] }
@@ -195,21 +222,13 @@ name_version_pair   ::    { LocalVersion OccName }
 name_version_pair   :  var_occ INTEGER                         { ($1, fromInteger $2) }
                     |  tc_occ  INTEGER                          { ($1, fromInteger $2) }
 
-instance_import_part :: { [Module] }
-instance_import_part :                                                 {   []    }
-                     | instance_import_part '__instimport' mod_name ';'
-                                                               { $3 : $1 }
 
 --------------------------------------------------------------------------
 
 exports_part   :: { [ExportItem] }
 exports_part   :                                       { [] }
-               | exports_part '__export' opt_bang mod_fs entities ';'
-                                               { (mkSysModuleFS $4 $3,$5) : $1 }
-
-opt_bang       :: { IfaceFlavour }
-opt_bang       :                                       { hiFile }
-               | '!'                                   { hiBootFile }
+               | exports_part '__export' 
+                 mod_fs entities ';'                   { (mkSysModuleFS $3, $4) : $1 }
 
 entities       :: { [RdrAvailInfo] }
 entities       :                                       { [] }
@@ -255,11 +274,8 @@ csigs1             : csig                          { [$1] }
                | csig ';' csigs1               { $1 : $3 }
 
 csig           :: { RdrNameSig }
-csig           :  src_loc var_name '::' type { ClassOpSig $2 Nothing $4 $1 }
-               |  src_loc var_name '=' '::' type       
-                       { ClassOpSig $2 
-                           (Just (error "Un-filled-in default method"))
-                           $5 $1 }
+csig           :  src_loc var_name '::' type           { mkClassOpSig False $2 $4 $1 }
+               |  src_loc var_name '=' '::' type       { mkClassOpSig True  $2 $5 $1 }
 
 --------------------------------------------------------------------------
 
@@ -272,7 +288,7 @@ inst_decl   :  src_loc 'instance' type '=' var_name ';'
                        { InstDecl $3
                                   EmptyMonoBinds       {- No bindings -}
                                   []                   {- No user pragmas -}
-                                  (Just $5)            {- Dfun id -}
+                                  $5                   {- Dfun id -}
                                   $1
                        }
 
@@ -292,21 +308,75 @@ decl    : src_loc var_name '::' type maybe_idinfo
                        { 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 
+       | src_loc 'class' decl_context tc_name tv_bndrs fds csigs
+                       { TyClD (mkClassDecl $3 $4 $5 $6 $7 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 $1 of
-                                    Succeeded (PIdInfo id_info) -> id_info
-                                    Failed err -> pprPanic "IdInfo parse failed" 
-                                                           (vcat [ppr x, err])
+             | pragma          { \x -> case $1 of
+                                    POk _ (PIdInfo id_info) -> id_info
+                                    PFailed err -> 
+                                       pprPanic "IdInfo parse failed" 
+                                           (vcat [ppr x, err])
+                               }
+
+pragma :: { ParseResult IfaceStuff }
+pragma : src_loc PRAGMA        { parseIface $2 PState{ bol = 0#, atbol = 1#,
+                                                       context = [],
+                                                       glasgow_exts = 1#,
+                                                       loc = $1 }
+                               }
+
+-----------------------------------------------------------------------------
+
+rules_and_deprecs :: { ([RdrNameRuleDecl], [RdrNameDeprecation]) }
+rules_and_deprecs : {- empty -}        { ([], []) }
+                 | rules_and_deprecs rule_or_deprec
+                               { let
+                                    append2 (xs1,ys1) (xs2,ys2) =
+                                       (xs1 `app` xs2, ys1 `app` ys2)
+                                    xs `app` [] = xs -- performance paranoia
+                                    xs `app` ys = xs ++ ys
+                                 in append2 $1 $2
                                }
 
+rule_or_deprec :: { ([RdrNameRuleDecl], [RdrNameDeprecation]) }
+rule_or_deprec : pragma        { case $1 of
+                            POk _ (PRules   rules)   -> (rules,[])
+                            POk _ (PDeprecs deprecs) -> ([],deprecs)
+                            PFailed err -> pprPanic "Rules/Deprecations 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 }
+                 
+-----------------------------------------------------------------------------
+
+deprecs        :: { [RdrNameDeprecation] }
+deprecs                : {- empty -}           { [] }
+               | deprecs deprec ';'    { $2 : $1 }
+
+deprec         :: { RdrNameDeprecation }
+deprec         : STRING                { Deprecation (IEModuleContents undefined) $1 }
+               | deprec_name STRING    { Deprecation $1 $2 }
+
+-- SUP: TEMPORARY HACK
+deprec_name    :: { RdrNameIE }
+               : var_name              { IEVar $1 }
+
 -----------------------------------------------------------------------------
 
 version                :: { Version }
@@ -316,7 +386,7 @@ decl_context        :: { RdrNameContext }
 decl_context   :                                       { [] }
                | '{' context_list1 '}' '=>'    { $2 }
 
-----------------------------------------------------------------
+----------------------------------------------------------------------------
 
 constrs                :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
                :                       { [] }
@@ -348,6 +418,7 @@ batypes             :                                       { [] }
 batype         :: { RdrNameBangType }
 batype         :  atype                                { Unbanged $1 }
                |  '!' atype                            { Banged   $2 }
+               |  '!' '!' atype                        { Unpacked $3 }
 
 fields1                :: { [([RdrName], RdrNameBangType)] }
 fields1                : field                                 { [$1] }
@@ -356,14 +427,19 @@ fields1           : field                                 { [$1] }
 field          :: { ([RdrName], RdrNameBangType) }
 field          :  var_names1 '::' type         { ($1, Unbanged $3) }
                |  var_names1 '::' '!' type     { ($1, Banged   $4) }
+               |  var_names1 '::' '!' '!' type { ($1, Unpacked $5) }
 --------------------------------------------------------------------------
 
 type           :: { RdrNameHsType }
-type           : '__forall' forall context '=>' type   
-                                               { mkHsForAllTy $2 $3 $5 }
+type           : '__fuall'  fuall '=>' type    { mkHsUsForAllTy $2 $4 }
+                | '__forall' forall context '=>' type  
+                                               { mkHsForAllTy (Just $2) $3 $5 }
                | btype '->' type               { MonoFunTy $1 $3 }
                | btype                         { $1 }
 
+fuall          :: { [RdrName] }
+fuall          : '[' uv_bndrs ']'                      { $2 }
+
 forall         :: { [HsTyVar RdrName] }
 forall         : '[' tv_bndrs ']'                      { $2 }
 
@@ -375,8 +451,14 @@ context_list1      :: { RdrNameContext }
 context_list1  : class                                 { [$1] }
                | class ',' context_list1               { $1 : $3 }
 
-class          :: { (RdrName, [RdrNameHsType]) }
-class          :  qcls_name atypes                     { ($1, $2) }
+class          :: { HsPred RdrName }
+class          :  qcls_name atypes                     { (HsPClass $1 $2) }
+               |  IPVARID '::' type                    { (HsPIParam (mkSysUnqual ipName $1) $3) }
+
+types0         :: { [RdrNameHsType]                    {- Zero or more -}  }   
+types0         :  {- empty -}                          { [ ] }
+               |  type                                 { [ $1 ] }
+               |  types2                               { $1 }
 
 types2         :: { [RdrNameHsType]                    {- Two or more -}  }    
 types2         :  type ',' type                        { [$1,$3] }
@@ -385,15 +467,21 @@ types2            :  type ',' type                        { [$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          :  qtc_name                             { MonoTyVar $1 }
                |  tv_name                              { MonoTyVar $1 }
                |  '(' types2 ')'                       { MonoTupleTy $2 True{-boxed-} }
-               |  '(#' type '#)'                       { MonoTupleTy [$2] False{-unboxed-} }
-               |  '(#' types2 '#)'                     { MonoTupleTy $2 False{-unboxed-} }
+               |  '(#' types0 '#)'                     { MonoTupleTy $2 False{-unboxed-} }
                |  '[' type ']'                         { MonoListTy  $2 }
                |  '{' qcls_name atypes '}'             { MonoDictTy $2 $3 }
+               |  '{' IPVARID '::' type '}'            { MonoIParamTy (mkSysUnqual ipName $2) $4 }
                |  '(' type ')'                         { $2 }
 
 -- This one is dealt with via qtc_name
@@ -406,19 +494,26 @@ atypes            :                                       { [] }
 mod_fs         :: { EncodedFS }
                :  CONID                { $1 }
 
-mod_name       :: { Module }
-               :  mod_fs               { mkSysModuleFS $1 hiFile }
+mod_name       :: { ModuleName }
+               :  mod_fs               { mkSysModuleFS $1 }
 
 
 ---------------------------------------------------
 var_fs         :: { EncodedFS }
                : VARID                 { $1 }
-               | VARSYM                { $1 }
-               | '-'                   { SLIT("-") }
                | '!'                   { SLIT("!") }
-
-
-qvar_fs                :: { (EncodedFS, EncodedFS, IfaceFlavour) }
+               | '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") }
+
+qvar_fs                :: { (EncodedFS, EncodedFS) }
                :  QVARID               { $1 }
                |  QVARSYM              { $1 }
 
@@ -449,7 +544,7 @@ data_fs             :: { EncodedFS }
                :  CONID                { $1 }
                |  CONSYM               { $1 }
 
-qdata_fs       :: { (EncodedFS, EncodedFS, IfaceFlavour) }
+qdata_fs       :: { (EncodedFS, EncodedFS) }
                 :  QCONID              { $1 }
                 |  QCONSYM             { $1 }
 
@@ -494,6 +589,17 @@ qcls_name  :: { RdrName }
                | qdata_fs              { mkSysQual clsName $1 }
 
 ---------------------------------------------------
+uv_name                :: { RdrName }
+               :  VARID                { mkSysUnqual uvName $1 }
+
+uv_bndr                :: { RdrName }
+               :  uv_name              { $1 }
+
+uv_bndrs       :: { [RdrName] }
+               :                       { [] }
+               | uv_bndr uv_bndrs      { $1 : $2 }
+
+---------------------------------------------------
 tv_name                :: { RdrName }
                :  VARID                { mkSysUnqual tvName $1 }
                |  VARSYM               { mkSysUnqual tvName $1 {- Allow t2 as a tyvar -} }
@@ -507,6 +613,22 @@ tv_bndrs   :: { [HsTyVar RdrName] }
                | tv_bndr tv_bndrs      { $1 : $2 }
 
 ---------------------------------------------------
+fds :: { [([RdrName], [RdrName])] }
+       : {- empty -}                   { [] }
+       | '|' fds1                      { reverse $2 }
+
+fds1 :: { [([RdrName], [RdrName])] }
+       : fds1 ',' fd                   { $3 : $1 }
+       | fd                            { [$1] }
+
+fd :: { ([RdrName], [RdrName]) }
+       : varids0 '->' varids0          { (reverse $1, reverse $3) }
+
+varids0        :: { [RdrName] }
+       : {- empty -}                   { [] }
+       | varids0 tv_name               { $2 : $1 }
+
+---------------------------------------------------
 kind           :: { Kind }
                : akind                 { $1 }
                | akind '->' kind       { mkArrowKind $1 $3 }
@@ -523,31 +645,21 @@ akind             :: { Kind }
 --------------------------------------------------------------------------
 
 id_info                :: { [HsIdInfo RdrName] }
-id_info                :                               { [] }
+               :                               { [] }
                | id_info_item id_info          { $1 : $2 }
 
 id_info_item   :: { HsIdInfo RdrName }
-id_info_item   : '__A' arity_info              { HsArity $2 }
-               | strict_info                   { HsStrictness $1 }
-               | '__U' core_expr               { HsUnfold $1 (Just $2) }
-                | '__U'                        { HsUnfold $1 Nothing }
-                | '__P' spec_tvs
-                     atypes '=' core_expr       { HsSpecialise $2 $3 $5 }
+               : '__A' INTEGER                 { HsArity (exactArity (fromInteger $2)) }
+               | '__U' inline_prag core_expr   { HsUnfold $2 $3 }
+               | '__M'                         { HsCprInfo $1 }
+               | '__S'                         { HsStrictness (HsStrictnessInfo $1) }
                | '__C'                         { HsNoCafRefs }
+               | '__P' qvar_name               { HsWorker $2 }
 
-
-spec_tvs       :: { [HsTyVar RdrName] }
-spec_tvs       : '[' tv_bndrs ']'              { $2 }
-       
-
-arity_info     :: { ArityInfo }
-arity_info     : INTEGER                       { exactArity (fromInteger $1) }
-
-strict_info    :: { HsStrictnessInfo RdrName }
-strict_info    : '__S' qvar_name '{' qdata_names '}'   
-                                       { HsStrictnessInfo $1 (Just ($2,$4)) }
-               | '__S' qvar_name       { HsStrictnessInfo $1 (Just ($2,[])) }
-               | '__S'                 { HsStrictnessInfo $1 Nothing }
+inline_prag     :: { InlinePragInfo }
+                :  {- empty -}                  { NoInlinePragInfo }
+                | '[' INTEGER ']'               { IMustNotBeINLINEd True  (Just (fromInteger $2)) } -- INLINE n
+                | '[' '!' INTEGER ']'           { IMustNotBeINLINEd False (Just (fromInteger $3)) } -- NOINLINE n
 
 -------------------------------------------------------
 core_expr      :: { UfExpr RdrName }
@@ -563,7 +675,8 @@ core_expr   : '\\' core_bndrs '->' core_expr        { foldr UfLam $4 $2 }
                | con_or_primop '{' core_args '}'       { UfCon $1 $3 }
                 | '__litlit' STRING atype               { UfCon (UfLitLitCon $2 $3) [] }
 
-                | '__inline' core_expr                  { UfNote UfInlineCall $2 }
+                | '__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 }
@@ -596,12 +709,16 @@ core_aexpr      : qvar_name                                       { UfVar $1 }
                | 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 }
+               | '(#' comma_exprs0 '#)' { UfTuple (mkUbxTupConRdrName (length $2)) $2 }
 
 -- This one is dealt with by qdata_name: see above comments
 --             | '('  ')'               { UfTuple (mkTupConRdrName 0) [] }
 
+comma_exprs0    :: { [UfExpr RdrName] }        -- Zero or more
+comma_exprs0   : {- empty -}                   { [ ] }
+               | core_expr                     { [ $1 ] }
+               | comma_exprs2                  { $1 }
+
 comma_exprs2   :: { [UfExpr RdrName] } -- Two or more
 comma_exprs2   : core_expr ',' core_expr                       { [$1,$3] }
                | core_expr ',' comma_exprs2                    { $1 : $3 }
@@ -629,35 +746,54 @@ 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) }
+               | qdata_name core_pat_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 }
 
-
+core_pat_names :: { [RdrName] }
+core_pat_names :                               { [] }
+               | core_pat_name core_pat_names  { $1 : $2 }
+
+-- Tyvar names and variable names live in different name spaces
+-- so they need to be signalled separately.  But we don't record 
+-- types or kinds in a pattern; we work that out from the type 
+-- of the case scrutinee
+core_pat_name  :: { RdrName }
+core_pat_name  : var_name                      { $1 }
+               | '@' tv_name                   { $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 }
+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 }
+               | rational                      { MachDouble $1 }
+               | '__float' rational            { MachFloat $2 }
 
-               | '__integer' INTEGER           { NoRepInteger  $2 (panic "NoRepInteger type") 
+               | '__integer' integer           { NoRepInteger  $2 (panic "NoRepInteger type") 
                                                        -- The type checker will add the types
                                                }
 
-               | '__rational' INTEGER INTEGER  { NoRepRational ($2 % $3) 
+               | '__rational' integer integer  { NoRepRational ($2 % $3) 
                                                   (panic "NoRepRational type")
                                                        -- The type checker will add the type
                                                }
 
-               | '__addr' INTEGER              { MachAddr $2 }
+               | '__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 }
@@ -676,6 +812,7 @@ core_tv_bndr        :  '@' tv_name '::' akind               { UfTyBinder $2 $4 }
 
 ccall_string   :: { FAST_STRING }
                : STRING                                        { $1 }
+               | CLITLIT                                       { $1 }
                | VARID                                         { $1 }
                | CONID                                         { $1 }
 
@@ -688,7 +825,7 @@ scc     :: { CostCentre }
 
 cc_name :: { EncodedFS }
         : CONID                 { $1 }
-        | VARID                 { $1 }
+        | var_fs                { $1 }
   
 cc_dup  :: { IsDupdCC }
 cc_dup  :                       { OriginalCC }
@@ -701,7 +838,7 @@ cc_caf  :: { IsCafCC }
 -------------------------------------------------------------------
 
 src_loc :: { SrcLoc }
-src_loc :                              {% getSrcLocIf }
+src_loc :                              {% getSrcLocP }
 
 checkVersion :: { () }
           : {-empty-}                  {% checkVersion Nothing }
@@ -711,10 +848,14 @@ checkVersion :: { () }
 
 --                     Haskell code 
 {
+happyError :: P a
+happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
 
 data IfaceStuff = PIface       EncodedFS{-.hi module name-} ParsedIface
                | PIdInfo       [HsIdInfo RdrName]
                | PType         RdrNameHsType
+               | PRules        [RdrNameRuleDecl]
+               | PDeprecs      [RdrNameDeprecation]
 
 mkConDecl name (ex_tvs, ex_ctxt) details loc = ConDecl name ex_tvs ex_ctxt details loc
 }