ghc/compiler/rename/ParseIface.y

   1 {
   2 module ParseIface ( parseIface, IfaceStuff(..) ) where
   3
   4 #include "HsVersions.h"
   5
   6 import HsSyn            -- quite a bit of stuff
   7 import RdrHsSyn         -- oodles of synonyms
   8 import HsTypes          ( mkHsForAllTy, mkHsUsForAllTy )
   9 import HsCore
  10 import Const            ( Literal(..), mkMachInt_safe )
  11 import BasicTypes       ( Fixity(..), FixityDirection(..),
  12                           NewOrData(..), Version
  13                         )
  14 import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
  15 import HsPragmas        ( noDataPragmas, noClassPragmas )
  16 import Type             ( Kind, mkArrowKind, boxedTypeKind, openTypeKind, UsageAnn(..) )
  17 import IdInfo           ( ArityInfo, exactArity, CprInfo(..) )
  18 import Lex
  19
  20 import RnMonad          ( ImportVersion, LocalVersion, ParsedIface(..), WhatsImported(..),
  21                           RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..), WhetherHasOrphans
  22                         )
  23 import Bag              ( emptyBag, unitBag, snocBag )
  24 import FiniteMap        ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
  25 import RdrName          ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual )
  26 import Name             ( OccName, Provenance )
  27 import OccName          ( mkSysOccFS,
  28                           tcName, varName, dataName, clsName, tvName, uvName,
  29                           EncodedFS
  30                         )
  31 import Module           ( ModuleName, mkSysModuleFS )
  32 import PrelMods         ( mkTupNameStr, mkUbxTupNameStr )
  33 import PrelInfo         ( mkTupConRdrName, mkUbxTupConRdrName )
  34 import SrcLoc           ( SrcLoc )
  35 import Maybes
  36 import Outputable
  37
  38 import GlaExts
  39
  40 #if __HASKELL1__ > 4
  41 import Ratio ( (%) )
  42 #endif
  43 }
  44
  45 %name       parseIface
  46 %tokentype  { Token }
  47 %monad      { P }{ thenP }{ returnP }
  48 %lexer      { lexer } { ITeof }
  49
  50 %token
  51  'case'         { ITcase }                      -- Haskell keywords
  52  'class'        { ITclass }
  53  'data'         { ITdata }
  54  'default'      { ITdefault }
  55  'deriving'     { ITderiving }
  56  'do'           { ITdo }
  57  'else'         { ITelse }
  58  'if'           { ITif }
  59  'import'       { ITimport }
  60  'in'           { ITin }
  61  'infix'        { ITinfix }
  62  'infixl'       { ITinfixl }
  63  'infixr'       { ITinfixr }
  64  'instance'     { ITinstance }
  65  'let'          { ITlet }
  66  'module'       { ITmodule }
  67  'newtype'      { ITnewtype }
  68  'of'           { ITof }
  69  'then'         { ITthen }
  70  'type'         { ITtype }
  71  'where'        { ITwhere }
  72  'as'           { ITas }
  73  'qualified'    { ITqualified }
  74  'hiding'       { IThiding }
  75
  76  'forall'       { ITforall }                    -- GHC extension keywords
  77  'foreign'      { ITforeign }
  78  'export'       { ITexport }
  79  'label'        { ITlabel }
  80  'dynamic'      { ITdynamic }
  81  'unsafe'       { ITunsafe }
  82
  83  '__interface'  { ITinterface }                 -- interface keywords
  84  '__export'     { IT__export }
  85  '__forall'     { IT__forall }
  86  '__depends'    { ITdepends }
  87  '__letrec'     { ITletrec }
  88  '__coerce'     { ITcoerce }
  89  '__inline_call'{ ITinlineCall }
  90  '__inline_me'  { ITinlineMe }
  91  '__DEFAULT'    { ITdefaultbranch }
  92  '__bot'        { ITbottom }
  93  '__integer'    { ITinteger_lit }
  94  '__float'      { ITfloat_lit }
  95  '__rational'   { ITrational_lit }
  96  '__addr'       { ITaddr_lit }
  97  '__litlit'     { ITlit_lit }
  98  '__string'     { ITstring_lit }
  99  '__ccall'      { ITccall $$ }
 100  '__scc'        { ITscc }
 101  '__sccC'       { ITsccAllCafs }
 102
 103  '__u'          { ITusage }
 104  '__fuall'      { ITfuall }
 105
 106  '__A'          { ITarity }
 107  '__P'          { ITspecialise }
 108  '__C'          { ITnocaf }
 109  '__U'          { ITunfold $$ }
 110  '__S'          { ITstrict $$ }
 111  '__R'          { ITrules }
 112  '__M'          { ITcprinfo $$ }
 113
 114  '..'           { ITdotdot }                    -- reserved symbols
 115  '::'           { ITdcolon }
 116  '='            { ITequal }
 117  '\\'           { ITlam }
 118  '|'            { ITvbar }
 119  '<-'           { ITlarrow }
 120  '->'           { ITrarrow }
 121  '@'            { ITat }
 122  '~'            { ITtilde }
 123  '=>'           { ITdarrow }
 124  '-'            { ITminus }
 125  '!'            { ITbang }
 126
 127  '/\\'          { ITbiglam }                    -- GHC-extension symbols
 128
 129  '{'            { ITocurly }                    -- special symbols
 130  '}'            { ITccurly }
 131  '['            { ITobrack }
 132  ']'            { ITcbrack }
 133  '('            { IToparen }
 134  ')'            { ITcparen }
 135  '(#'           { IToubxparen }
 136  '#)'           { ITcubxparen }
 137  ';'            { ITsemi }
 138  ','            { ITcomma }
 139
 140  VARID          { ITvarid    $$ }               -- identifiers
 141  CONID          { ITconid    $$ }
 142  VARSYM         { ITvarsym   $$ }
 143  CONSYM         { ITconsym   $$ }
 144  QVARID         { ITqvarid   $$ }
 145  QCONID         { ITqconid   $$ }
 146  QVARSYM        { ITqvarsym  $$ }
 147  QCONSYM        { ITqconsym  $$ }
 148
 149  PRAGMA         { ITpragma   $$ }
 150
 151  CHAR           { ITchar     $$ }
 152  STRING         { ITstring   $$ }
 153  INTEGER        { ITinteger  $$ }
 154  RATIONAL       { ITrational $$ }
 155  CLITLIT        { ITlitlit   $$ }
 156
 157  UNKNOWN        { ITunknown  $$ }
 158 %%
 159
 160 -- iface_stuff is the main production.
 161 -- It recognises (a) a whole interface file
 162 --               (b) a type (so that type sigs can be parsed lazily)
 163 --               (c) the IdInfo part of a signature (same reason)
 164
 165 iface_stuff :: { IfaceStuff }
 166 iface_stuff : iface             { let (nm, iff) = $1 in PIface nm iff }
 167             | type              { PType   $1 }
 168             | id_info           { PIdInfo $1 }
 169             | '__R' rules       { PRules  $2 }
 170
 171
 172 iface           :: { (ModuleName, ParsedIface) }
 173 iface           : '__interface' mod_fs INTEGER orphans checkVersion 'where'
 174                   exports_part
 175                   import_part
 176                   instance_decl_part
 177                   decls_part
 178                   rules_part
 179                   { ( $2                        -- Module name
 180                     , ParsedIface {
 181                         pi_mod = fromInteger $3,        -- Module version
 182                         pi_orphan  = $4,
 183                         pi_exports = $7,        -- Exports
 184                         pi_usages  = $8,        -- Usages
 185                         pi_insts   = $9,        -- Local instances
 186                         pi_decls   = $10,       -- Decls
 187                         pi_rules   = $11        -- Rules
 188                       } ) }
 189
 190 --------------------------------------------------------------------------
 191
 192 import_part :: { [ImportVersion OccName] }
 193 import_part :                                             { [] }
 194             |  import_part import_decl                    { $2 : $1 }
 195
 196 import_decl :: { ImportVersion OccName }
 197 import_decl : 'import' mod_fs INTEGER orphans whats_imported ';'
 198                         { (mkSysModuleFS $2, fromInteger $3, $4, $5) }
 199         -- import Foo 3 :: a 1 b 3 c 7 ;        means import a,b,c from Foo
 200         -- import Foo 3 ;                       means import all of Foo
 201         -- import Foo 3 ! :: ...stuff... ;      the ! means that Foo contains orphans
 202
 203 orphans             :: { WhetherHasOrphans }
 204 orphans             :                                           { False }
 205                     | '!'                                       { True }
 206
 207 whats_imported      :: { WhatsImported OccName }
 208 whats_imported      :                                           { Everything }
 209                     | '::' name_version_pairs                   { Specifically $2 }
 210
 211 name_version_pairs  ::  { [LocalVersion OccName] }
 212 name_version_pairs  :                                           { [] }
 213                     |  name_version_pair name_version_pairs     { $1 : $2 }
 214
 215 name_version_pair   ::  { LocalVersion OccName }
 216 name_version_pair   :  var_occ INTEGER                          { ($1, fromInteger $2) }
 217                     |  tc_occ  INTEGER                          { ($1, fromInteger $2) }
 218
 219
 220 --------------------------------------------------------------------------
 221
 222 exports_part    :: { [ExportItem] }
 223 exports_part    :                                       { [] }
 224                 | exports_part '__export'
 225                   mod_fs entities ';'                   { (mkSysModuleFS $3, $4) : $1 }
 226
 227 entities        :: { [RdrAvailInfo] }
 228 entities        :                                       { [] }
 229                 |  entity entities                      { $1 : $2 }
 230
 231 entity          :: { RdrAvailInfo }
 232 entity          :  tc_occ                               { AvailTC $1 [$1] }
 233                 |  var_occ                              { Avail $1 }
 234                 |  tc_occ stuff_inside                  { AvailTC $1 ($1:$2) }
 235                 |  tc_occ '|' stuff_inside              { AvailTC $1 $3 }
 236
 237 stuff_inside    :: { [OccName] }
 238 stuff_inside    :  '{' val_occs '}'                     { $2 }
 239
 240 val_occ         :: { OccName }
 241                 :  var_occ              { $1 }
 242                 |  data_occ             { $1 }
 243
 244 val_occs        :: { [OccName] }
 245                 :  val_occ              { [$1] }
 246                 |  val_occ val_occs     { $1 : $2 }
 247
 248
 249 --------------------------------------------------------------------------
 250
 251 fixity      :: { FixityDirection }
 252 fixity      : 'infixl'                                  { InfixL }
 253             | 'infixr'                                  { InfixR }
 254             | 'infix'                                   { InfixN }
 255
 256 mb_fix      :: { Int }
 257 mb_fix      : {-nothing-}                               { 9 }
 258             | INTEGER                                   { (fromInteger $1) }
 259
 260 -----------------------------------------------------------------------------
 261
 262 csigs           :: { [RdrNameSig] }
 263 csigs           :                               { [] }
 264                 | 'where' '{' csigs1 '}'        { $3 }
 265
 266 csigs1          :: { [RdrNameSig] }
 267 csigs1          : csig                          { [$1] }
 268                 | csig ';' csigs1               { $1 : $3 }
 269
 270 csig            :: { RdrNameSig }
 271 csig            :  src_loc var_name '::' type           { mkClassOpSig False $2 $4 $1 }
 272                 |  src_loc var_name '=' '::' type       { mkClassOpSig True  $2 $5 $1 }
 273
 274 --------------------------------------------------------------------------
 275
 276 instance_decl_part :: { [RdrNameInstDecl] }
 277 instance_decl_part : {- empty -}                       { [] }
 278                    | instance_decl_part inst_decl      { $2 : $1 }
 279
 280 inst_decl       :: { RdrNameInstDecl }
 281 inst_decl       :  src_loc 'instance' type '=' var_name ';'
 282                         { InstDecl $3
 283                                    EmptyMonoBinds       {- No bindings -}
 284                                    []                   {- No user pragmas -}
 285                                    $5                   {- Dfun id -}
 286                                    $1
 287                         }
 288
 289 --------------------------------------------------------------------------
 290
 291 decls_part :: { [(Version, RdrNameHsDecl)] }
 292 decls_part
 293         :  {- empty -}                          { [] }
 294         |  decls_part version decl ';'          { ($2,$3):$1 }
 295
 296 decl    :: { RdrNameHsDecl }
 297 decl    : src_loc var_name '::' type maybe_idinfo
 298                          { SigD (IfaceSig $2 $4 ($5 $2) $1) }
 299         | src_loc 'type' tc_name tv_bndrs '=' type
 300                         { TyClD (TySynonym $3 $4 $6 $1) }
 301         | src_loc 'data' decl_context tc_name tv_bndrs constrs
 302                         { TyClD (TyData DataType $3 $4 $5 $6 Nothing noDataPragmas $1) }
 303         | src_loc 'newtype' decl_context tc_name tv_bndrs newtype_constr
 304                         { TyClD (TyData NewType $3 $4 $5 $6 Nothing noDataPragmas $1) }
 305         | src_loc 'class' decl_context tc_name tv_bndrs csigs
 306                         { TyClD (mkClassDecl $3 $4 $5 $6 EmptyMonoBinds
 307                                         noClassPragmas $1) }
 308         | src_loc fixity mb_fix var_or_data_name
 309                         { FixD (FixitySig $4 (Fixity $3 $2) $1) }
 310
 311 maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
 312 maybe_idinfo  : {- empty -}     { \_ -> [] }
 313               | src_loc PRAGMA  { \x ->
 314                                    case parseIface $2
 315                                            PState{bol = 0#, atbol = 1#,
 316                                                   context = [],
 317                                                   glasgow_exts = 1#,
 318                                                   loc = $1 } of
 319                                      POk _ (PIdInfo id_info) -> id_info
 320                                      PFailed err ->
 321                                         pprPanic "IdInfo parse failed"
 322                                             (vcat [ppr x, err])
 323                                 }
 324
 325 -----------------------------------------------------------------------------
 326
 327 rules_part :: { [RdrNameRuleDecl] }
 328 rules_part : {- empty -}        { [] }
 329            | src_loc PRAGMA     { case parseIface $2
 330                                            PState{bol = 0#, atbol = 1#,
 331                                                   context = [],
 332                                                   glasgow_exts = 1#,
 333                                                   loc = $1 }  of
 334                                      POk _ (PRules rules) -> rules
 335                                      PFailed err ->
 336                                           pprPanic "Rules parse failed" err
 337                                 }
 338
 339 rules      :: { [RdrNameRuleDecl] }
 340            : {- empty -}        { [] }
 341            | rule ';' rules     { $1:$3 }
 342
 343 rule       :: { RdrNameRuleDecl }
 344 rule       : src_loc STRING rule_forall qvar_name
 345              core_args '=' core_expr    { IfaceRuleDecl $4 (UfRuleBody $2 $3 $5 $7) $1 }
 346
 347 rule_forall     :: { [UfBinder RdrName] }
 348 rule_forall     : '__forall' '{' core_bndrs '}' { $3 }
 349
 350 -----------------------------------------------------------------------------
 351
 352 version         :: { Version }
 353 version         :  INTEGER                              { fromInteger $1 }
 354
 355 decl_context    :: { RdrNameContext }
 356 decl_context    :                                       { [] }
 357                 | '{' context_list1 '}' '=>'    { $2 }
 358
 359 ----------------------------------------------------------------------------
 360
 361 constrs         :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
 362                 :                       { [] }
 363                 | '=' constrs1          { $2 }
 364
 365 constrs1        :: { [RdrNameConDecl] }
 366 constrs1        :  constr               { [$1] }
 367                 |  constr '|' constrs1  { $1 : $3 }
 368
 369 constr          :: { RdrNameConDecl }
 370 constr          :  src_loc ex_stuff data_name batypes           { mkConDecl $3 $2 (VanillaCon $4) $1 }
 371                 |  src_loc ex_stuff data_name '{' fields1 '}'   { mkConDecl $3 $2 (RecCon $5)     $1 }
 372                 -- We use "data_fs" so as to include ()
 373
 374 newtype_constr  :: { [RdrNameConDecl] {- Empty if handwritten abstract -} }
 375 newtype_constr  :                                       { [] }
 376                 | src_loc '=' ex_stuff data_name atype  { [mkConDecl $4 $3 (NewCon $5 Nothing) $1] }
 377                 | src_loc '=' ex_stuff data_name '{' var_name '::' atype '}'
 378                                                         { [mkConDecl $4 $3 (NewCon $8 (Just $6)) $1] }
 379
 380 ex_stuff :: { ([HsTyVar RdrName], RdrNameContext) }
 381 ex_stuff        :                                       { ([],[]) }
 382                 | '__forall' forall context '=>'            { ($2,$3) }
 383
 384 batypes         :: { [RdrNameBangType] }
 385 batypes         :                                       { [] }
 386                 |  batype batypes                       { $1 : $2 }
 387
 388 batype          :: { RdrNameBangType }
 389 batype          :  atype                                { Unbanged $1 }
 390                 |  '!' atype                            { Banged   $2 }
 391                 |  '!' '!' atype                        { Unpacked $3 }
 392
 393 fields1         :: { [([RdrName], RdrNameBangType)] }
 394 fields1         : field                                 { [$1] }
 395                 | field ',' fields1                     { $1 : $3 }
 396
 397 field           :: { ([RdrName], RdrNameBangType) }
 398 field           :  var_names1 '::' type         { ($1, Unbanged $3) }
 399                 |  var_names1 '::' '!' type     { ($1, Banged   $4) }
 400                 |  var_names1 '::' '!' '!' type { ($1, Unpacked $5) }
 401 --------------------------------------------------------------------------
 402
 403 type            :: { RdrNameHsType }
 404 type            : '__fuall'  fuall '=>' type    { mkHsUsForAllTy $2 $4 }
 405                 | '__forall' forall context '=>' type
 406                                                 { mkHsForAllTy $2 $3 $5 }
 407                 | btype '->' type               { MonoFunTy $1 $3 }
 408                 | btype                         { $1 }
 409
 410 fuall           :: { [RdrName] }
 411 fuall           : '[' uv_bndrs ']'                      { $2 }
 412
 413 forall          :: { [HsTyVar RdrName] }
 414 forall          : '[' tv_bndrs ']'                      { $2 }
 415
 416 context         :: { RdrNameContext }
 417 context         :                                       { [] }
 418                 | '{' context_list1 '}'                 { $2 }
 419
 420 context_list1   :: { RdrNameContext }
 421 context_list1   : class                                 { [$1] }
 422                 | class ',' context_list1               { $1 : $3 }
 423
 424 class           :: { (RdrName, [RdrNameHsType]) }
 425 class           :  qcls_name atypes                     { ($1, $2) }
 426
 427 types2          :: { [RdrNameHsType]                    {- Two or more -}  }
 428 types2          :  type ',' type                        { [$1,$3] }
 429                 |  type ',' types2                      { $1 : $3 }
 430
 431 btype           :: { RdrNameHsType }
 432 btype           :  atype                                { $1 }
 433                 |  btype atype                          { MonoTyApp $1 $2 }
 434                 |  '__u' usage atype                    { MonoUsgTy $2 $3 }
 435
 436 usage           :: { MonoUsageAnn RdrName }
 437 usage           : '-'                                   { MonoUsOnce }
 438                 | '!'                                   { MonoUsMany }
 439                 | uv_name                               { MonoUsVar $1 }
 440
 441 atype           :: { RdrNameHsType }
 442 atype           :  qtc_name                             { MonoTyVar $1 }
 443                 |  tv_name                              { MonoTyVar $1 }
 444                 |  '(' types2 ')'                       { MonoTupleTy $2 True{-boxed-} }
 445                 |  '(#' type '#)'                       { MonoTupleTy [$2] False{-unboxed-} }
 446                 |  '(#' types2 '#)'                     { MonoTupleTy $2 False{-unboxed-} }
 447                 |  '[' type ']'                         { MonoListTy  $2 }
 448                 |  '{' qcls_name atypes '}'             { MonoDictTy $2 $3 }
 449                 |  '(' type ')'                         { $2 }
 450
 451 -- This one is dealt with via qtc_name
 452 --              |  '(' ')'                              { MonoTupleTy [] True }
 453
 454 atypes          :: { [RdrNameHsType]    {-  Zero or more -} }
 455 atypes          :                                       { [] }
 456                 |  atype atypes                         { $1 : $2 }
 457 ---------------------------------------------------------------------
 458 mod_fs          :: { EncodedFS }
 459                 :  CONID                { $1 }
 460
 461 mod_name        :: { ModuleName }
 462                 :  mod_fs               { mkSysModuleFS $1 }
 463
 464
 465 ---------------------------------------------------
 466 var_fs          :: { EncodedFS }
 467                 : VARID                 { $1 }
 468                 | VARSYM                { $1 }
 469                 | '!'                   { SLIT("!") }
 470                 | 'as'                  { SLIT("as") }
 471                 | 'qualified'           { SLIT("qualified") }
 472                 | 'hiding'              { SLIT("hiding") }
 473                 | 'forall'              { SLIT("forall") }
 474                 | 'foreign'             { SLIT("foreign") }
 475                 | 'export'              { SLIT("export") }
 476                 | 'label'               { SLIT("label") }
 477                 | 'dynamic'             { SLIT("dynamic") }
 478                 | 'unsafe'              { SLIT("unsafe") }
 479
 480 qvar_fs         :: { (EncodedFS, EncodedFS) }
 481                 :  QVARID               { $1 }
 482                 |  QVARSYM              { $1 }
 483
 484 var_occ         :: { OccName }
 485                 :  var_fs               { mkSysOccFS varName $1 }
 486
 487 var_name        :: { RdrName }
 488 var_name        :  var_occ              { mkRdrUnqual $1 }
 489
 490 qvar_name       :: { RdrName }
 491 qvar_name       :  var_name             { $1 }
 492                 |  qvar_fs              { mkSysQual varName $1 }
 493
 494 var_names       :: { [RdrName] }
 495 var_names       :                       { [] }
 496                 | var_name var_names    { $1 : $2 }
 497
 498 var_names1      :: { [RdrName] }
 499 var_names1      : var_name var_names    { $1 : $2 }
 500
 501 ---------------------------------------------------
 502 -- For some bizarre reason,
 503 --      (,,,)      is dealt with by the parser
 504 --      Foo.(,,,)  is dealt with by the lexer
 505 -- Sigh
 506
 507 data_fs         :: { EncodedFS }
 508                 :  CONID                { $1 }
 509                 |  CONSYM               { $1 }
 510
 511 qdata_fs        :: { (EncodedFS, EncodedFS) }
 512                 :  QCONID               { $1 }
 513                 |  QCONSYM              { $1 }
 514
 515 data_occ        :: { OccName }
 516                 :  data_fs              { mkSysOccFS dataName $1 }
 517
 518 data_name       :: { RdrName }
 519                 :  data_occ             { mkRdrUnqual $1 }
 520
 521 qdata_name      :: { RdrName }
 522 qdata_name      :  data_name            { $1 }
 523                 |  qdata_fs             { mkSysQual dataName $1 }
 524
 525 qdata_names     :: { [RdrName] }
 526 qdata_names     :                               { [] }
 527                 | qdata_name qdata_names        { $1 : $2 }
 528
 529 var_or_data_name :: { RdrName }
 530                   : var_name                    { $1 }
 531                   | data_name                   { $1 }
 532
 533 ---------------------------------------------------
 534 tc_fs           :: { EncodedFS }
 535                 :  data_fs              { $1 }
 536
 537 tc_occ          :: { OccName }
 538                 :  tc_fs                { mkSysOccFS tcName $1 }
 539
 540 tc_name         :: { RdrName }
 541                 :  tc_occ               { mkRdrUnqual $1 }
 542
 543 qtc_name        :: { RdrName }
 544                 : tc_name               { $1 }
 545                 | qdata_fs              { mkSysQual tcName $1 }
 546
 547 ---------------------------------------------------
 548 cls_name        :: { RdrName }
 549                 :  data_fs              { mkSysUnqual clsName $1 }
 550
 551 qcls_name       :: { RdrName }
 552                 : cls_name              { $1 }
 553                 | qdata_fs              { mkSysQual clsName $1 }
 554
 555 ---------------------------------------------------
 556 uv_name         :: { RdrName }
 557                 :  VARID                { mkSysUnqual uvName $1 }
 558
 559 uv_bndr         :: { RdrName }
 560                 :  uv_name              { $1 }
 561
 562 uv_bndrs        :: { [RdrName] }
 563                 :                       { [] }
 564                 | uv_bndr uv_bndrs      { $1 : $2 }
 565
 566 ---------------------------------------------------
 567 tv_name         :: { RdrName }
 568                 :  VARID                { mkSysUnqual tvName $1 }
 569                 |  VARSYM               { mkSysUnqual tvName $1 {- Allow t2 as a tyvar -} }
 570
 571 tv_bndr         :: { HsTyVar RdrName }
 572                 :  tv_name '::' akind   { IfaceTyVar $1 $3 }
 573                 |  tv_name              { IfaceTyVar $1 boxedTypeKind }
 574
 575 tv_bndrs        :: { [HsTyVar RdrName] }
 576                 :                       { [] }
 577                 | tv_bndr tv_bndrs      { $1 : $2 }
 578
 579 ---------------------------------------------------
 580 kind            :: { Kind }
 581                 : akind                 { $1 }
 582                 | akind '->' kind       { mkArrowKind $1 $3 }
 583
 584 akind           :: { Kind }
 585                 : VARSYM                { if $1 == SLIT("*") then
 586                                                 boxedTypeKind
 587                                           else if $1 == SLIT("?") then
 588                                                 openTypeKind
 589                                           else panic "ParseInterface: akind"
 590                                         }
 591                 | '(' kind ')'  { $2 }
 592
 593 --------------------------------------------------------------------------
 594
 595 id_info         :: { [HsIdInfo RdrName] }
 596                 :                               { [] }
 597                 | id_info_item id_info          { $1 : $2 }
 598
 599 id_info_item    :: { HsIdInfo RdrName }
 600                 : '__A' INTEGER                 { HsArity (exactArity (fromInteger $2)) }
 601                 | '__U' core_expr               { HsUnfold $1 (Just $2) }
 602                 | '__U'                         { HsUnfold $1 Nothing }
 603                 | '__M'                         { HsCprInfo $1 }
 604                 | '__S'                         { HsStrictness (HsStrictnessInfo $1) }
 605                 | '__C'                         { HsNoCafRefs }
 606                 | '__P' qvar_name               { HsWorker $2 }
 607
 608 -------------------------------------------------------
 609 core_expr       :: { UfExpr RdrName }
 610 core_expr       : '\\' core_bndrs '->' core_expr        { foldr UfLam $4 $2 }
 611                 | 'case' core_expr 'of' var_name
 612                   '{' core_alts '}'                     { UfCase $2 $4 $6 }
 613
 614                 | 'let' '{' core_val_bndr '=' core_expr
 615                       '}' 'in' core_expr                { UfLet (UfNonRec $3 $5) $8 }
 616                 | '__letrec' '{' rec_binds '}'
 617                   'in' core_expr                        { UfLet (UfRec $3) $6 }
 618
 619                 | con_or_primop '{' core_args '}'       { UfCon $1 $3 }
 620                 | '__litlit' STRING atype               { UfCon (UfLitLitCon $2 $3) [] }
 621
 622                 | '__inline_me' core_expr               { UfNote UfInlineMe $2 }
 623                 | '__inline_call' core_expr             { UfNote UfInlineCall $2 }
 624                 | '__coerce' atype core_expr            { UfNote (UfCoerce $2) $3 }
 625                 | scc core_expr                         { UfNote (UfSCC $1) $2  }
 626                 | fexpr                                 { $1 }
 627
 628 fexpr   :: { UfExpr RdrName }
 629 fexpr   : fexpr core_arg                                { UfApp $1 $2 }
 630         | core_aexpr                                    { $1 }
 631
 632 core_arg        :: { UfExpr RdrName }
 633                 : '@' atype                                     { UfType $2 }
 634                 | core_aexpr                                    { $1 }
 635
 636 core_args       :: { [UfExpr RdrName] }
 637                 :                                               { [] }
 638                 | core_arg core_args                            { $1 : $2 }
 639
 640 core_aexpr      :: { UfExpr RdrName }              -- Atomic expressions
 641 core_aexpr      : qvar_name                                     { UfVar $1 }
 642
 643                 | qdata_name                                    { UfVar $1 }
 644                         -- This one means that e.g. "True" will parse as
 645                         -- (UfVar True_Id) rather than (UfCon True_Con []).
 646                         -- No big deal; it'll be inlined in a jiffy.  I tried
 647                         -- parsing it to (Con con []) directly, but got bitten
 648                         -- when a real constructor Id showed up in an interface
 649                         -- file.  As usual, a hack bites you in the end.
 650                         -- If you want to get a UfCon, then use the
 651                         -- curly-bracket notation (True {}).
 652
 653                 | core_lit               { UfCon (UfLitCon $1) [] }
 654                 | '(' core_expr ')'      { $2 }
 655                 | '(' comma_exprs2 ')'   { UfTuple (mkTupConRdrName (length $2)) $2 }
 656                 | '(#' core_expr '#)'    { UfTuple (mkUbxTupConRdrName 1) [$2] }
 657                 | '(#' comma_exprs2 '#)' { UfTuple (mkUbxTupConRdrName (length $2)) $2 }
 658
 659 -- This one is dealt with by qdata_name: see above comments
 660 --              | '('  ')'               { UfTuple (mkTupConRdrName 0) [] }
 661
 662 comma_exprs2    :: { [UfExpr RdrName] } -- Two or more
 663 comma_exprs2    : core_expr ',' core_expr                       { [$1,$3] }
 664                 | core_expr ',' comma_exprs2                    { $1 : $3 }
 665
 666 con_or_primop   :: { UfCon RdrName }
 667 con_or_primop   : qdata_name                    { UfDataCon $1 }
 668                 | qvar_name                     { UfPrimOp $1 }
 669                 | '__ccall' ccall_string      { let
 670                                                 (is_dyn, is_casm, may_gc) = $1
 671                                                 in
 672                                                 UfCCallOp $2 is_dyn is_casm may_gc
 673                                                 }
 674
 675 rec_binds       :: { [(UfBinder RdrName, UfExpr RdrName)] }
 676                 :                                               { [] }
 677                 | core_val_bndr '=' core_expr ';' rec_binds     { ($1,$3) : $5 }
 678
 679 core_alts       :: { [UfAlt RdrName] }
 680                 : core_alt                                      { [$1] }
 681                 | core_alt ';' core_alts                        { $1 : $3 }
 682
 683 core_alt        :: { UfAlt RdrName }
 684 core_alt        : core_pat '->' core_expr       { (fst $1, snd $1, $3) }
 685
 686 core_pat        :: { (UfCon RdrName, [RdrName]) }
 687 core_pat        : core_lit                      { (UfLitCon  $1, []) }
 688                 | '__litlit' STRING atype       { (UfLitLitCon $2 $3, []) }
 689                 | qdata_name var_names          { (UfDataCon $1, $2) }
 690                 | '(' comma_var_names1 ')'      { (UfDataCon (mkTupConRdrName (length $2)), $2) }
 691                 | '(#' comma_var_names1 '#)'    { (UfDataCon (mkUbxTupConRdrName (length $2)), $2) }
 692                 | '__DEFAULT'                   { (UfDefault, []) }
 693                 | '(' core_pat ')'              { $2 }
 694
 695
 696 comma_var_names1 :: { [RdrName] }       -- One or more
 697 comma_var_names1 : var_name                                     { [$1] }
 698                  | var_name ',' comma_var_names1                { $1 : $3 }
 699
 700 core_lit        :: { Literal }
 701 core_lit        : integer                       { mkMachInt_safe $1 }
 702                 | CHAR                          { MachChar $1 }
 703                 | STRING                        { MachStr $1 }
 704                 | '__string' STRING             { NoRepStr $2 (panic "NoRepStr type") }
 705                 | rational                      { MachDouble $1 }
 706                 | '__float' rational            { MachFloat $2 }
 707
 708                 | '__integer' integer           { NoRepInteger  $2 (panic "NoRepInteger type")
 709                                                         -- The type checker will add the types
 710                                                 }
 711
 712                 | '__rational' integer integer  { NoRepRational ($2 % $3)
 713                                                    (panic "NoRepRational type")
 714                                                         -- The type checker will add the type
 715                                                 }
 716
 717                 | '__addr' integer              { MachAddr $2 }
 718
 719 integer         :: { Integer }
 720                 : INTEGER                       { $1 }
 721                 | '-' INTEGER                   { (-$2) }
 722
 723 rational        :: { Rational }
 724                 : RATIONAL                      { $1 }
 725                 | '-' RATIONAL                  { (-$2) }
 726
 727 core_bndr       :: { UfBinder RdrName }
 728 core_bndr       : core_val_bndr                                 { $1 }
 729                 | core_tv_bndr                                  { $1 }
 730
 731 core_bndrs      :: { [UfBinder RdrName] }
 732 core_bndrs      :                                               { [] }
 733                 | core_bndr core_bndrs                          { $1 : $2 }
 734
 735 core_val_bndr   :: { UfBinder RdrName }
 736 core_val_bndr   : var_name '::' atype                           { UfValBinder $1 $3 }
 737
 738 core_tv_bndr    :: { UfBinder RdrName }
 739 core_tv_bndr    :  '@' tv_name '::' akind               { UfTyBinder $2 $4 }
 740                 |  '@' tv_name                          { UfTyBinder $2 boxedTypeKind }
 741
 742 ccall_string    :: { FAST_STRING }
 743                 : STRING                                        { $1 }
 744                 | CLITLIT                                       { $1 }
 745                 | VARID                                         { $1 }
 746                 | CONID                                         { $1 }
 747
 748 ------------------------------------------------------------------------
 749 scc     :: { CostCentre }
 750         :  '__sccC' '{' mod_name STRING '}'                      { AllCafsCC $3 $4 }
 751         |  '__scc' '{' cc_name mod_name STRING cc_dup cc_caf '}'
 752                              { NormalCC { cc_name = $3, cc_mod = $4, cc_grp = $5,
 753                                           cc_is_dupd = $6, cc_is_caf = $7 } }
 754
 755 cc_name :: { EncodedFS }
 756         : CONID                 { $1 }
 757         | VARID                 { $1 }
 758
 759 cc_dup  :: { IsDupdCC }
 760 cc_dup  :                       { OriginalCC }
 761         | '!'                   { DupdCC }
 762
 763 cc_caf  :: { IsCafCC }
 764         :                       { NotCafCC }
 765         | '__C'                 { CafCC }
 766
 767 -------------------------------------------------------------------
 768
 769 src_loc :: { SrcLoc }
 770 src_loc :                               {% getSrcLocP }
 771
 772 checkVersion :: { () }
 773            : {-empty-}                  {% checkVersion Nothing }
 774            | INTEGER                    {% checkVersion (Just (fromInteger $1)) }
 775
 776 -------------------------------------------------------------------
 777
 778 --                      Haskell code
 779 {
 780 happyError :: P a
 781 happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
 782
 783 data IfaceStuff = PIface        EncodedFS{-.hi module name-} ParsedIface
 784                 | PIdInfo       [HsIdInfo RdrName]
 785                 | PType         RdrNameHsType
 786                 | PRules        [RdrNameRuleDecl]
 787
 788 mkConDecl name (ex_tvs, ex_ctxt) details loc = ConDecl name ex_tvs ex_ctxt details loc
 789 }