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