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