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