ghc/compiler/rename/ParseIface.y

   1 {-      Notes about the syntax of interface files                 -*-haskell-*-
   2         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   3 The header
   4 ~~~~~~~~~~
   5   interface "edison" M 4 6 2 ! 406      Module M, version 4, from package 'edison',
   6                                         Fixities version 6, rules version 2
   7                                         Interface syntax version 406
   8                                         ! means M contains orphans
   9
  10 Import declarations
  11 ~~~~~~~~~~~~~~~~~~~
  12   import Foo ;                          To compile M I used nothing from Foo, but it's
  13                                         below me in the hierarchy
  14
  15   import Foo ! @ ;                      Ditto, but the ! means that Foo contains orphans
  16                                         and        the @ means that Foo is a boot interface
  17
  18   import Foo :: 3 ;                     To compile M I used everything from Foo, which has
  19                                         module version 3
  20
  21   import Foo :: 3 2 6 a 1 b 3 c 7 ;     To compile M I used Foo.  It had
  22                                                 module version 3
  23                                                 fixity version 2
  24                                                 rules  version 6
  25                                         and some specific things besides.
  26
  27 -}
  28
  29
  30 {
  31 module ParseIface ( parseIface, parseType, parseRules, parseIdInfo ) where
  32
  33 #include "HsVersions.h"
  34
  35 import HsSyn            -- quite a bit of stuff
  36 import RdrHsSyn         -- oodles of synonyms
  37 import HsTypes          ( mkHsForAllTy, mkHsTupCon )
  38 import HsCore
  39 import Literal          ( Literal(..), mkMachInt, mkMachInt64, mkMachWord, mkMachWord64 )
  40 import BasicTypes       ( Fixity(..), FixityDirection(..), StrictnessMark(..),
  41                           NewOrData(..), Version, initialVersion, Boxity(..),
  42                           Activation(..), IPName(..)
  43                         )
  44 import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
  45 import Type             ( Kind, mkArrowKind, liftedTypeKind, openTypeKind, usageTypeKind )
  46 import ForeignCall      ( ForeignCall(..), CCallConv(..), CCallSpec(..), CCallTarget(..) )
  47 import Lex
  48
  49 import RnMonad          ( ParsedIface(..), ExportItem, IfaceDeprecs )
  50 import HscTypes         ( WhetherHasOrphans, IsBootInterface, GenAvailInfo(..),
  51                           ImportVersion, WhatsImported(..),
  52                           RdrAvailInfo )
  53
  54 import RdrName          ( RdrName, mkRdrUnqual, mkIfaceOrig )
  55 import TyCon            ( DataConDetails(..) )
  56 import Name             ( OccName )
  57 import OccName          ( mkSysOccFS,
  58                           tcName, varName, dataName, clsName, tvName,
  59                           EncodedFS
  60                         )
  61 import Module           ( ModuleName, PackageName, mkSysModuleNameFS )
  62 import SrcLoc           ( SrcLoc )
  63 import CmdLineOpts      ( opt_InPackage, opt_IgnoreIfacePragmas )
  64 import Outputable
  65 import Class            ( DefMeth (..) )
  66
  67 import GlaExts
  68 import FastString       ( tailFS )
  69 }
  70
  71 %name       parseIface      iface
  72 %name       parseType       type
  73 %name       parseIdInfo     id_info
  74 %name       parseRules      rules_and_deprecs
  75
  76 %tokentype  { Token }
  77 %monad      { P }{ thenP }{ returnP }
  78 %lexer      { lexer } { ITeof }
  79
  80 %token
  81  'as'           { ITas }
  82  'case'         { ITcase }                      -- Haskell keywords
  83  'class'        { ITclass }
  84  'data'         { ITdata }
  85  'hiding'       { IThiding }
  86  'import'       { ITimport }
  87  'in'           { ITin }
  88  'infix'        { ITinfix }
  89  'infixl'       { ITinfixl }
  90  'infixr'       { ITinfixr }
  91  'instance'     { ITinstance }
  92  'let'          { ITlet }
  93  'newtype'      { ITnewtype }
  94  'of'           { ITof }
  95  'qualified'    { ITqualified }
  96  'type'         { ITtype }
  97  'where'        { ITwhere }
  98
  99  'forall'       { ITforall }                    -- GHC extension keywords
 100  'foreign'      { ITforeign }
 101  'export'       { ITexport }
 102  'label'        { ITlabel }
 103  'dynamic'      { ITdynamic }
 104  'unsafe'       { ITunsafe }
 105  'with'         { ITwith }
 106  'stdcall'      { ITstdcallconv }
 107  'ccall'        { ITccallconv }
 108
 109  '__interface'  { ITinterface }                 -- interface keywords
 110  '__export'     { IT__export }
 111  '__forall'     { IT__forall }
 112  '__letrec'     { ITletrec }
 113  '__coerce'     { ITcoerce }
 114  '__inline_me'  { ITinlineMe }
 115  '__inline_call'{ ITinlineCall }
 116  '__DEFAULT'    { ITdefaultbranch }
 117  '__float'      { ITfloat_lit }
 118  '__word'       { ITword_lit }
 119  '__int64'      { ITint64_lit }
 120  '__word64'     { ITword64_lit }
 121  '__addr'       { ITaddr_lit }
 122  '__label'      { ITlabel_lit }
 123  '__litlit'     { ITlit_lit }
 124  '__ccall'      { ITccall $$ }
 125  '__scc'        { ITscc }
 126  '__sccC'       { ITsccAllCafs }
 127
 128  '__u'          { ITusage }
 129
 130  '__A'          { ITarity }
 131  '__P'          { ITspecialise }
 132  '__C'          { ITnocaf }
 133  '__U'          { ITunfold }
 134  '__S'          { ITstrict $$ }
 135  '__R'          { ITrules }
 136  '__D'          { ITdeprecated }
 137
 138  '::'           { ITdcolon }
 139  '='            { ITequal }
 140  '\\'           { ITlam }
 141  '|'            { ITvbar }
 142  '->'           { ITrarrow }
 143  '@'            { ITat }
 144  '~'            { ITtilde }
 145  '=>'           { ITdarrow }
 146  '-'            { ITminus }
 147  '!'            { ITbang }
 148  '*'            { ITstar }
 149
 150  '{'            { ITocurly }                    -- special symbols
 151  '}'            { ITccurly }
 152  '['            { ITobrack }
 153  ']'            { ITcbrack }
 154  '[:'           { ITopabrack }
 155  ':]'           { ITcpabrack }
 156  '('            { IToparen }
 157  ')'            { ITcparen }
 158  '(#'           { IToubxparen }
 159  '#)'           { ITcubxparen }
 160  ';'            { ITsemi }
 161  ','            { ITcomma }
 162  '.'            { ITdot }
 163
 164  VARID          { ITvarid    $$ }               -- identifiers
 165  CONID          { ITconid    $$ }
 166  VARSYM         { ITvarsym   $$ }
 167  QVARID         { ITqvarid   $$ }
 168  QCONID         { ITqconid   $$ }
 169
 170  IPDUPVARID     { ITdupipvarid   $$ }           -- GHC extension
 171  IPSPLITVARID   { ITsplitipvarid $$ }           -- GHC extension
 172
 173  PRAGMA         { ITpragma   $$ }
 174
 175  CHAR           { ITchar     $$ }
 176  STRING         { ITstring   $$ }
 177  INTEGER        { ITinteger  $$ }
 178  RATIONAL       { ITrational $$ }
 179  CLITLIT        { ITlitlit   $$ }
 180 %%
 181
 182 iface           :: { ParsedIface }
 183 iface           : '__interface' package mod_name
 184                         version sub_versions
 185                         orphans checkVersion 'where'
 186                   exports_part
 187                   import_part
 188                   fix_decl_part
 189                   instance_decl_part
 190                   decls_part
 191                   rules_and_deprecs_part
 192                   { let (rules,deprecs) = $14 () in
 193                     ParsedIface {
 194                         pi_mod  = $3,                   -- Module name
 195                         pi_pkg = $2,                    -- Package name
 196                         pi_vers = $4,                   -- Module version
 197                         pi_orphan  = $6,
 198                         pi_exports = (fst $5, $9),      -- Exports
 199                         pi_usages  = $10,               -- Usages
 200                         pi_fixity  = $11,               -- Fixies
 201                         pi_insts   = $12,               -- Local instances
 202                         pi_decls   = $13,               -- Decls
 203                         pi_rules   = (snd $5,rules),    -- Rules
 204                         pi_deprecs = deprecs            -- Deprecations
 205                    } }
 206
 207 -- Versions for exports and rules (optional)
 208 sub_versions :: { (Version,Version) }
 209         : '[' version version ']'               { ($2,$3) }
 210         | {- empty -}                           { (initialVersion, initialVersion) }
 211
 212 --------------------------------------------------------------------------
 213
 214 import_part :: { [ImportVersion OccName] }
 215 import_part :                                             { [] }
 216             |  import_decl import_part                    { $1 : $2 }
 217
 218 import_decl :: { ImportVersion OccName }
 219 import_decl : 'import' mod_name orphans is_boot whats_imported ';'
 220                         { ({-mkSysModuleNameFS-} $2, $3, $4, $5) }
 221
 222 orphans             :: { WhetherHasOrphans }
 223 orphans             :                                           { False }
 224                     | '!'                                       { True }
 225
 226 is_boot             :: { IsBootInterface }
 227 is_boot             :                                           { False }
 228                     | '@'                                       { True }
 229
 230 whats_imported      :: { WhatsImported OccName }
 231 whats_imported      :                                                   { NothingAtAll }
 232                     | '::' version                                      { Everything $2 }
 233                     | '::' version version version name_version_pairs   { Specifically $2 (Just $3) $5 $4 }
 234                     | '::' version version name_version_pairs           { Specifically $2 Nothing $4 $3 }
 235
 236 name_version_pairs  ::  { [(OccName, Version)] }
 237 name_version_pairs  :                                           { [] }
 238                     |  name_version_pair name_version_pairs     { $1 : $2 }
 239
 240 name_version_pair   ::  { (OccName, Version) }
 241 name_version_pair   :  var_occ version                          { ($1, $2) }
 242                     |  tc_occ  version                          { ($1, $2) }
 243
 244
 245 --------------------------------------------------------------------------
 246
 247 exports_part    :: { [ExportItem] }
 248 exports_part    :                                       { [] }
 249                 | '__export' mod_name entities ';'
 250                         exports_part                    { ({-mkSysModuleNameFS-} $2, $3) : $5 }
 251
 252 entities        :: { [RdrAvailInfo] }
 253 entities        :                                       { [] }
 254                 |  entity entities                      { $1 : $2 }
 255
 256 entity          :: { RdrAvailInfo }
 257 entity          :  var_occ                              { Avail $1 }
 258                 |  tc_occ                               { AvailTC $1 [$1] }
 259                 |  tc_occ '|' stuff_inside              { AvailTC $1 $3 }
 260                 |  tc_occ stuff_inside                  { AvailTC $1 ($1:$2) }
 261                 -- Note that the "main name" comes at the beginning
 262
 263 stuff_inside    :: { [OccName] }
 264 stuff_inside    :  '{' val_occs '}'                     { $2 }
 265
 266 val_occ         :: { OccName }
 267                 :  var_occ              { $1 }
 268                 |  data_occ             { $1 }
 269
 270 val_occs        :: { [OccName] }
 271                 :  val_occ              { [$1] }
 272                 |  val_occ val_occs     { $1 : $2 }
 273
 274
 275 --------------------------------------------------------------------------
 276
 277 fix_decl_part :: { [RdrNameFixitySig] }
 278 fix_decl_part : {- empty -}                             { [] }
 279               | fix_decls ';'                           { $1 }
 280
 281 fix_decls     :: { [RdrNameFixitySig] }
 282 fix_decls     :                                         { [] }
 283               | fix_decl fix_decls                      { $1 : $2 }
 284
 285 fix_decl :: { RdrNameFixitySig }
 286 fix_decl : src_loc fixity prec var_or_data_name         { FixitySig $4 (Fixity $3 $2) $1 }
 287
 288 fixity      :: { FixityDirection }
 289 fixity      : 'infixl'                                  { InfixL }
 290             | 'infixr'                                  { InfixR }
 291             | 'infix'                                   { InfixN }
 292
 293 prec        :: { Int }
 294 prec        : INTEGER                                   { fromInteger $1 }
 295
 296 -----------------------------------------------------------------------------
 297
 298 csigs           :: { [RdrNameSig] }
 299 csigs           :                               { [] }
 300                 | 'where' '{' csigs1 '}'        { $3 }
 301
 302 csigs1          :: { [RdrNameSig] }
 303 csigs1          :                               { [] }
 304                 | csig ';' csigs1               { $1 : $3 }
 305
 306 csig            :: { RdrNameSig }
 307 csig            :  src_loc qvar_name '::' type          { ClassOpSig $2 NoDefMeth $4 $1 }
 308                 |  src_loc qvar_name ';' '::' type      { ClassOpSig $2 GenDefMeth $5 $1 }
 309                 |  src_loc qvar_name '=' '::' type      { mkClassOpSigDM $2 $5 $1 }
 310
 311 --------------------------------------------------------------------------
 312
 313 instance_decl_part :: { [RdrNameInstDecl] }
 314 instance_decl_part : {- empty -}                       { [] }
 315                    | instance_decl_part inst_decl      { $2 : $1 }
 316
 317 inst_decl       :: { RdrNameInstDecl }
 318 inst_decl       :  src_loc 'instance' type '=' qvar_name ';'
 319                         { InstDecl $3
 320                                    EmptyMonoBinds       {- No bindings -}
 321                                    []                   {- No user pragmas -}
 322                                    (Just $5)            {- Dfun id -}
 323                                    $1
 324                         }
 325
 326 --------------------------------------------------------------------------
 327
 328 decls_part :: { [(Version, RdrNameTyClDecl)] }
 329 decls_part
 330         :  {- empty -}                          { [] }
 331         |  opt_version decl ';' decls_part              { ($1,$2):$4 }
 332
 333 decl    :: { RdrNameTyClDecl }
 334 decl    : src_loc qvar_name '::' type maybe_idinfo
 335                         { IfaceSig $2 $4 ($5 $2) $1 }
 336         | src_loc 'type' qtc_name tv_bndrs '=' type
 337                         { TySynonym $3 $4 $6 $1 }
 338         | src_loc 'foreign' 'type' qtc_name
 339                         { ForeignType $4 Nothing DNType $1 }
 340         | src_loc 'data' tycl_hdr constrs
 341                         { mkTyData DataType $3 $4 Nothing $1 }
 342         | src_loc 'newtype' tycl_hdr newtype_constr
 343                         { mkTyData NewType $3 (DataCons [$4]) Nothing $1 }
 344         | src_loc 'class' tycl_hdr fds csigs
 345                         { mkClassDecl $3 $4 $5 Nothing $1 }
 346
 347 tycl_hdr :: { (RdrNameContext, RdrName, [RdrNameHsTyVar]) }
 348         : context '=>' qtc_name tv_bndrs        { ($1, $3, $4) }
 349         | qtc_name tv_bndrs                     { ([], $1, $2) }
 350
 351 maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
 352 maybe_idinfo  : {- empty -}     { \_ -> [] }
 353               | pragma          { \x -> if opt_IgnoreIfacePragmas then []
 354                                         else case $1 of
 355                                                 Just (POk _ id_info) -> id_info
 356                                                 Just (PFailed err) -> pprPanic "IdInfo parse failed"
 357                                                                         (vcat [ppr x, err])
 358                                 }
 359     {-
 360       If a signature decl is being loaded, and opt_IgnoreIfacePragmas is on,
 361       we toss away unfolding information.
 362
 363       Also, if the signature is loaded from a module we're importing from source,
 364       we do the same. This is to avoid situations when compiling a pair of mutually
 365       recursive modules, peering at unfolding info in the interface file of the other,
 366       e.g., you compile A, it looks at B's interface file and may as a result change
 367       its interface file. Hence, B is recompiled, maybe changing its interface file,
 368       which will the unfolding info used in A to become invalid. Simple way out is to
 369       just ignore unfolding info.
 370
 371       [Jan 99: I junked the second test above.  If we're importing from an hi-boot
 372        file there isn't going to *be* any pragma info.  The above comment
 373        dates from a time where we picked up a .hi file first if it existed.]
 374     -}
 375
 376 pragma  :: { Maybe (ParseResult [HsIdInfo RdrName]) }
 377 pragma  : src_loc PRAGMA        { let exts = ExtFlags {glasgowExtsEF = True,
 378                                                        parrEF        = True}
 379                                   in
 380                                   Just (parseIdInfo $2 (mkPState $1 exts))
 381                                 }
 382
 383 -----------------------------------------------------------------------------
 384
 385 -- This production is lifted so that it doesn't get eagerly parsed when we
 386 -- use happy --strict.
 387 rules_and_deprecs_part :: { () -> ([RdrNameRuleDecl], IfaceDeprecs) }
 388 rules_and_deprecs_part
 389   : {- empty -}         { \_ -> ([], Nothing) }
 390   | src_loc PRAGMA      { \_ -> let exts = ExtFlags {glasgowExtsEF = True,
 391                                                      parrEF        = True}
 392                                 in case parseRules $2 (mkPState $1 exts) of
 393                                         POk _ rds   -> rds
 394                                         PFailed err -> pprPanic "Rules/Deprecations parse failed" err
 395                         }
 396
 397 rules_and_deprecs :: { ([RdrNameRuleDecl], IfaceDeprecs) }
 398 rules_and_deprecs : rule_prag deprec_prag       { ($1, $2) }
 399
 400
 401 -----------------------------------------------------------------------------
 402
 403 rule_prag :: { [RdrNameRuleDecl] }
 404 rule_prag : {- empty -}                 { [] }
 405           | '__R' rules                 { $2 }
 406
 407 rules      :: { [RdrNameRuleDecl] }
 408            : {- empty -}        { [] }
 409            | rule ';' rules     { $1:$3 }
 410
 411 rule       :: { RdrNameRuleDecl }
 412 rule       : src_loc STRING activation rule_forall qvar_name
 413              core_args '=' core_expr    { IfaceRule $2 $3 $4 $5 $6 $8 $1 }
 414
 415 activation :: { Activation }
 416 activation : {- empty -}                { AlwaysActive }
 417            | '[' INTEGER ']'            { ActiveAfter (fromInteger $2) }
 418            | '[' '~' INTEGER ']'        { ActiveBefore (fromInteger $3) }
 419
 420 rule_forall     :: { [UfBinder RdrName] }
 421 rule_forall     : '__forall' '{' core_bndrs '}' { $3 }
 422
 423 -----------------------------------------------------------------------------
 424
 425 deprec_prag     :: { IfaceDeprecs }
 426 deprec_prag     : {- empty -}           { Nothing }
 427                 | '__D' deprecs         { Just $2 }
 428
 429 deprecs         :: { Either DeprecTxt [(RdrName,DeprecTxt)] }
 430 deprecs         : STRING                { Left $1 }
 431                 | deprec_list           { Right $1 }
 432
 433 deprec_list     :: { [(RdrName,DeprecTxt)] }
 434 deprec_list     : deprec                        { [$1] }
 435                 | deprec ';' deprec_list        { $1 : $3 }
 436
 437 deprec          :: { (RdrName,DeprecTxt) }
 438 deprec          : deprec_name STRING    { ($1, $2) }
 439
 440 deprec_name     :: { RdrName }
 441                 : qvar_name             { $1 }
 442                 | qtc_name              { $1 }
 443
 444 -----------------------------------------------------------------------------
 445
 446 version         :: { Version }
 447 version         :  INTEGER                      { fromInteger $1 }
 448
 449 opt_version     :: { Version }
 450 opt_version     : version                       { $1 }
 451                 | {- empty -}                   { initialVersion }
 452
 453
 454 ----------------------------------------------------------------------------
 455
 456 constrs         :: { DataConDetails RdrNameConDecl }
 457                 :                       { Unknown }
 458                 | '='                   { DataCons [] }
 459                 | '=' constrs1          { DataCons $2 }
 460
 461 constrs1        :: { [RdrNameConDecl] }
 462 constrs1        :  constr               { [$1] }
 463                 |  constr '|' constrs1  { $1 : $3 }
 464
 465 constr          :: { RdrNameConDecl }
 466 constr          :  src_loc ex_stuff qdata_name batypes          { mk_con_decl $3 $2 (VanillaCon $4) $1 }
 467                 |  src_loc ex_stuff qdata_name '{' fields1 '}'  { mk_con_decl $3 $2 (RecCon $5)     $1 }
 468                 -- We use "data_fs" so as to include ()
 469
 470 newtype_constr  :: { RdrNameConDecl }
 471 newtype_constr  : src_loc '=' ex_stuff qdata_name atype { mk_con_decl $4 $3 (VanillaCon [unbangedType $5]) $1 }
 472                 | src_loc '=' ex_stuff qdata_name '{' qvar_name '::' atype '}'
 473                                                         { mk_con_decl $4 $3 (RecCon [([$6], unbangedType $8)]) $1 }
 474
 475 ex_stuff :: { ([HsTyVarBndr RdrName], RdrNameContext) }
 476 ex_stuff        :                                       { ([],[]) }
 477                 | '__forall' tv_bndrs opt_context '=>'  { ($2,$3) }
 478
 479 batypes         :: { [RdrNameBangType] }
 480 batypes         :                                       { [] }
 481                 |  batype batypes                       { $1 : $2 }
 482
 483 batype          :: { RdrNameBangType }
 484 batype          :  tatype                               { unbangedType $1 }
 485                 |  '!' tatype                           { BangType MarkedStrict    $2 }
 486                 |  '!' '!' tatype                       { BangType MarkedUnboxed   $3 }
 487
 488 fields1         :: { [([RdrName], RdrNameBangType)] }
 489 fields1         : field                                 { [$1] }
 490                 | field ',' fields1                     { $1 : $3 }
 491
 492 field           :: { ([RdrName], RdrNameBangType) }
 493 field           :  qvar_names1 '::' ttype               { ($1, unbangedType $3) }
 494                 |  qvar_names1 '::' '!' ttype           { ($1, BangType MarkedStrict    $4) }
 495                 |  qvar_names1 '::' '!' '!' ttype       { ($1, BangType MarkedUnboxed   $5) }
 496
 497 --------------------------------------------------------------------------
 498
 499 type            :: { RdrNameHsType }
 500 type            : '__forall' tv_bndrs
 501                         opt_context '=>' type   { mkHsForAllTy (Just $2) $3 $5 }
 502                 | btype '->' type               { HsFunTy $1 $3 }
 503                 | btype                         { $1 }
 504
 505 opt_context     :: { RdrNameContext }
 506 opt_context     :                                       { [] }
 507                 | context                               { $1 }
 508
 509 context         :: { RdrNameContext }
 510 context         : '(' context_list1 ')'                 { $2 }
 511                 | '{' context_list1 '}'                 { $2 }  -- Backward compatibility
 512
 513 context_list1   :: { RdrNameContext }
 514 context_list1   : class                                 { [$1] }
 515                 | class ',' context_list1               { $1 : $3 }
 516
 517 class           :: { HsPred RdrName }
 518 class           :  qcls_name atypes                     { (HsClassP $1 $2) }
 519                 |  ipvar_name '::' type                 { (HsIParam $1 $3) }
 520
 521 types0          :: { [RdrNameHsType]                    {- Zero or more -}  }
 522 types0          :  {- empty -}                          { [ ] }
 523                 |  type                                 { [ $1 ] }
 524                 |  types2                               { $1 }
 525
 526 types2          :: { [RdrNameHsType]                    {- Two or more -}  }
 527 types2          :  type ',' type                        { [$1,$3] }
 528                 |  type ',' types2                      { $1 : $3 }
 529
 530 btype           :: { RdrNameHsType }
 531 btype           :  atype                                { $1 }
 532                 |  btype atype                          { HsAppTy $1 $2 }
 533
 534 atype           :: { RdrNameHsType }
 535 atype           :  qtc_name                             { HsTyVar $1 }
 536                 |  tv_name                              { HsTyVar $1 }
 537                 |  '.'                                  { hsUsOnce }
 538                 |  '!'                                  { hsUsMany }
 539                 |  '(' ')'                              { HsTupleTy (mkHsTupCon tcName Boxed   []) [] }
 540                 |  '(' types2 ')'                       { HsTupleTy (mkHsTupCon tcName Boxed   $2) $2 }
 541                 |  '(#' types0 '#)'                     { HsTupleTy (mkHsTupCon tcName Unboxed $2) $2 }
 542                 |  '[' type ']'                         { HsListTy  $2 }
 543                 |  '[:' type ':]'                       { HsPArrTy $2 }
 544                 |  '{' qcls_name atypes '}'             { mkHsDictTy $2 $3 }
 545                 |  '{' ipvar_name '::' type '}'         { mkHsIParamTy $2 $4 }
 546                 |  '(' type ')'                         { $2 }
 547
 548 atypes          :: { [RdrNameHsType]    {-  Zero or more -} }
 549 atypes          :                                       { [] }
 550                 |  atype atypes                         { $1 : $2 }
 551 --------------------------------------------------------------------------
 552
 553 -- versions of type/btype/atype that cant begin with '!' (or '.')
 554 -- for use where the kind is definitely known NOT to be '$'
 555
 556 ttype           :: { RdrNameHsType }
 557 ttype           : '__forall' tv_bndrs
 558                         opt_context '=>' type           { mkHsForAllTy (Just $2) $3 $5 }
 559                 | tbtype '->' type                      { HsFunTy $1 $3 }
 560                 | tbtype                                { $1 }
 561
 562 tbtype          :: { RdrNameHsType }
 563 tbtype          :  tatype                               { $1 }
 564                 |  tbtype atype                         { HsAppTy $1 $2 }
 565
 566 tatype          :: { RdrNameHsType }
 567 tatype          :  qtc_name                             { HsTyVar $1 }
 568                 |  tv_name                              { HsTyVar $1 }
 569                 |  '(' ')'                              { HsTupleTy (mkHsTupCon tcName Boxed   []) [] }
 570                 |  '(' types2 ')'                       { HsTupleTy (mkHsTupCon tcName Boxed   $2) $2 }
 571                 |  '(#' types0 '#)'                     { HsTupleTy (mkHsTupCon tcName Unboxed $2) $2 }
 572                 |  '[' type ']'                         { HsListTy  $2 }
 573                 |  '[:' type ':]'                       { HsPArrTy $2 }
 574                 |  '{' qcls_name atypes '}'             { mkHsDictTy $2 $3 }
 575                 |  '{' ipvar_name '::' type '}'         { mkHsIParamTy $2 $4 }
 576                 |  '(' type ')'                         { $2 }
 577 ---------------------------------------------------------------------
 578
 579 package         :: { PackageName }
 580                 :  STRING               { $1 }
 581                 | {- empty -}           { opt_InPackage }
 582                                 -- Useful for .hi-boot files,
 583                                 -- which can omit the package Id
 584                                 -- Module loops are always within a package
 585
 586 mod_name        :: { ModuleName }
 587                 :  CONID                { mkSysModuleNameFS $1 }
 588
 589
 590 ---------------------------------------------------
 591 var_fs          :: { EncodedFS }
 592                 : VARID                 { $1 }
 593                 | 'as'                  { SLIT("as") }
 594                 | 'qualified'           { SLIT("qualified") }
 595                 | 'hiding'              { SLIT("hiding") }
 596                 | 'forall'              { SLIT("forall") }
 597                 | 'foreign'             { SLIT("foreign") }
 598                 | 'export'              { SLIT("export") }
 599                 | 'label'               { SLIT("label") }
 600                 | 'dynamic'             { SLIT("dynamic") }
 601                 | 'unsafe'              { SLIT("unsafe") }
 602                 | 'with'                { SLIT("with") }
 603                 | 'ccall'               { SLIT("ccall") }
 604                 | 'stdcall'             { SLIT("stdcall") }
 605
 606 var_occ         :: { OccName }
 607                 :  var_fs               { mkSysOccFS varName $1 }
 608
 609 var_name        :: { RdrName }
 610 var_name        :  var_occ              { mkRdrUnqual $1 }
 611
 612 qvar_name       :: { RdrName }
 613 qvar_name       :  var_name             { $1 }
 614                 |  QVARID               { mkIfaceOrig varName $1 }
 615
 616 ipvar_name      :: { IPName RdrName }
 617                 : IPDUPVARID            { Dupable (mkRdrUnqual (mkSysOccFS varName $1)) }
 618                 | IPSPLITVARID          { Linear  (mkRdrUnqual (mkSysOccFS varName $1)) }
 619
 620 qvar_names1     :: { [RdrName] }
 621 qvar_names1     : qvar_name             { [$1] }
 622                 | qvar_name qvar_names1 { $1 : $2 }
 623
 624 ---------------------------------------------------
 625
 626 data_occ        :: { OccName }
 627                 :  CONID                { mkSysOccFS dataName $1 }
 628
 629 qdata_name      :: { RdrName }
 630                 :  data_occ             { mkRdrUnqual $1 }
 631                 |  QCONID               { mkIfaceOrig dataName $1 }
 632
 633 var_or_data_name :: { RdrName }
 634                   : qvar_name           { $1 }
 635                   | qdata_name          { $1 }
 636
 637 ---------------------------------------------------
 638 tc_occ          :: { OccName }
 639                 :  CONID                { mkSysOccFS tcName $1 }
 640
 641 qtc_name        :: { RdrName }
 642                 : tc_occ                { mkRdrUnqual $1 }
 643                 | QCONID                { mkIfaceOrig tcName $1 }
 644
 645 ---------------------------------------------------
 646 qcls_name       :: { RdrName }
 647                 : CONID                 { mkRdrUnqual (mkSysOccFS clsName $1) }
 648                 | QCONID                { mkIfaceOrig clsName $1 }
 649
 650 ---------------------------------------------------
 651 tv_name         :: { RdrName }
 652                 :  var_fs               { mkRdrUnqual (mkSysOccFS tvName $1) }
 653
 654 tv_bndr         :: { HsTyVarBndr RdrName }
 655                 :  tv_name '::' akind   { IfaceTyVar $1 $3 }
 656                 |  tv_name              { IfaceTyVar $1 liftedTypeKind }
 657
 658 tv_bndrs        :: { [HsTyVarBndr RdrName] }
 659                 : tv_bndrs1             { $1 }
 660                 | '[' tv_bndrs1 ']'     { $2 }  -- Backward compatibility
 661
 662 tv_bndrs1       :: { [HsTyVarBndr RdrName] }
 663                 :                       { [] }
 664                 | tv_bndr tv_bndrs1     { $1 : $2 }
 665
 666 ---------------------------------------------------
 667 fds :: { [([RdrName], [RdrName])] }
 668         : {- empty -}                   { [] }
 669         | '|' fds1                      { reverse $2 }
 670
 671 fds1 :: { [([RdrName], [RdrName])] }
 672         : fds1 ',' fd                   { $3 : $1 }
 673         | fd                            { [$1] }
 674
 675 fd :: { ([RdrName], [RdrName]) }
 676         : varids0 '->' varids0          { (reverse $1, reverse $3) }
 677
 678 varids0 :: { [RdrName] }
 679         : {- empty -}                   { [] }
 680         | varids0 tv_name               { $2 : $1 }
 681
 682 ---------------------------------------------------
 683 kind            :: { Kind }
 684                 : akind                 { $1 }
 685                 | akind '->' kind       { mkArrowKind $1 $3 }
 686
 687 akind           :: { Kind }
 688                 : '*'                   { liftedTypeKind }
 689                 | VARSYM                { if $1 == SLIT("?") then
 690                                                 openTypeKind
 691                                           else if $1 == SLIT("\36") then
 692                                                 usageTypeKind  -- dollar
 693                                           else panic "ParseInterface: akind"
 694                                         }
 695                 | '(' kind ')'  { $2 }
 696
 697 --------------------------------------------------------------------------
 698
 699 id_info         :: { [HsIdInfo RdrName] }
 700                 : id_info_item                  { [$1] }
 701                 | id_info_item id_info          { $1 : $2 }
 702
 703 id_info_item    :: { HsIdInfo RdrName }
 704                 : '__A' INTEGER                 { HsArity (fromInteger $2) }
 705                 | '__U' activation core_expr    { HsUnfold $2 $3 }
 706                 | '__S'                         { HsStrictness $1 }
 707                 | '__C'                         { HsNoCafRefs }
 708                 | '__P' qvar_name INTEGER       { HsWorker $2 (fromInteger $3) }
 709
 710 -------------------------------------------------------
 711 core_expr       :: { UfExpr RdrName }
 712 core_expr       : '\\' core_bndrs '->' core_expr        { foldr UfLam $4 $2 }
 713                 | 'case' core_expr 'of' var_name
 714                   '{' core_alts '}'                     { UfCase $2 $4 $6 }
 715
 716                 | 'let' '{' core_val_bndr '=' core_expr
 717                       '}' 'in' core_expr                { UfLet (UfNonRec $3 $5) $8 }
 718                 | '__letrec' '{' rec_binds '}'
 719                   'in' core_expr                        { UfLet (UfRec $3) $6 }
 720
 721                 | '__litlit' STRING atype               { UfLitLit $2 $3 }
 722
 723                 | fexpr                                 { $1 }
 724
 725 fexpr   :: { UfExpr RdrName }
 726 fexpr   : fexpr core_arg                                { UfApp $1 $2 }
 727         | scc core_aexpr                                { UfNote (UfSCC $1) $2  }
 728         | '__inline_me' core_aexpr                      { UfNote UfInlineMe $2 }
 729         | '__inline_call' core_aexpr                    { UfNote UfInlineCall $2 }
 730         | '__coerce' atype core_aexpr                   { UfNote (UfCoerce $2) $3 }
 731         | core_aexpr                                    { $1 }
 732
 733 core_arg        :: { UfExpr RdrName }
 734                 : '@' atype                                     { UfType $2 }
 735                 | core_aexpr                                    { $1 }
 736
 737 core_args       :: { [UfExpr RdrName] }
 738                 :                                               { [] }
 739                 | core_arg core_args                            { $1 : $2 }
 740
 741 core_aexpr      :: { UfExpr RdrName }              -- Atomic expressions
 742 core_aexpr      : qvar_name                                     { UfVar $1 }
 743                 | qdata_name                                    { UfVar $1 }
 744
 745                 | core_lit               { UfLit $1 }
 746                 | '(' core_expr ')'      { $2 }
 747
 748                 | '('  ')'               { UfTuple (mkHsTupCon dataName Boxed [])   [] }
 749                 | '(' comma_exprs2 ')'   { UfTuple (mkHsTupCon dataName Boxed $2)   $2 }
 750                 | '(#' comma_exprs0 '#)' { UfTuple (mkHsTupCon dataName Unboxed $2) $2 }
 751
 752                 | '{' '__ccall' ccall_string type '}'
 753                            { let
 754                                  (is_dyn, is_casm, may_gc) = $2
 755
 756                                  target | is_dyn    = DynamicTarget
 757                                         | is_casm   = CasmTarget $3
 758                                         | otherwise = StaticTarget $3
 759
 760                                  ccall = CCallSpec target CCallConv may_gc
 761                              in
 762                              UfFCall (CCall ccall) $4
 763                            }
 764
 765
 766 comma_exprs0    :: { [UfExpr RdrName] } -- Zero or more
 767 comma_exprs0    : {- empty -}                   { [ ] }
 768                 | core_expr                     { [ $1 ] }
 769                 | comma_exprs2                  { $1 }
 770
 771 comma_exprs2    :: { [UfExpr RdrName] } -- Two or more
 772 comma_exprs2    : core_expr ',' core_expr                       { [$1,$3] }
 773                 | core_expr ',' comma_exprs2                    { $1 : $3 }
 774
 775 rec_binds       :: { [(UfBinder RdrName, UfExpr RdrName)] }
 776                 :                                               { [] }
 777                 | core_val_bndr '=' core_expr ';' rec_binds     { ($1,$3) : $5 }
 778
 779 core_alts       :: { [UfAlt RdrName] }
 780                 :                                               { [] }
 781                 | core_alt ';' core_alts                        { $1 : $3 }
 782
 783 core_alt        :: { UfAlt RdrName }
 784 core_alt        : core_pat '->' core_expr       { (fst $1, snd $1, $3) }
 785
 786 core_pat        :: { (UfConAlt RdrName, [RdrName]) }
 787 core_pat        : core_lit                      { (UfLitAlt  $1, []) }
 788                 | '__litlit' STRING atype       { (UfLitLitAlt $2 $3, []) }
 789                 | qdata_name core_pat_names     { (UfDataAlt $1, $2) }
 790                 | '('  ')'                      { (UfTupleAlt (mkHsTupCon dataName Boxed []),   []) }
 791                 | '(' comma_var_names1 ')'      { (UfTupleAlt (mkHsTupCon dataName Boxed $2),   $2) }
 792                 | '(#' comma_var_names1 '#)'    { (UfTupleAlt (mkHsTupCon dataName Unboxed $2), $2) }
 793                 | '__DEFAULT'                   { (UfDefault, []) }
 794                 | '(' core_pat ')'              { $2 }
 795
 796 core_pat_names :: { [RdrName] }
 797 core_pat_names :                                { [] }
 798                 | core_pat_name core_pat_names  { $1 : $2 }
 799
 800 -- Tyvar names and variable names live in different name spaces
 801 -- so they need to be signalled separately.  But we don't record
 802 -- types or kinds in a pattern; we work that out from the type
 803 -- of the case scrutinee
 804 core_pat_name   :: { RdrName }
 805 core_pat_name   : var_name                      { $1 }
 806                 | '@' tv_name                   { $2 }
 807
 808 comma_var_names1 :: { [RdrName] }       -- One or more
 809 comma_var_names1 : var_name                                     { [$1] }
 810                  | var_name ',' comma_var_names1                { $1 : $3 }
 811
 812 core_lit        :: { Literal }
 813 core_lit        : integer                       { mkMachInt $1 }
 814                 | CHAR                          { MachChar $1 }
 815                 | STRING                        { MachStr $1 }
 816                 | rational                      { MachDouble $1 }
 817                 | '__word' integer              { mkMachWord $2 }
 818                 | '__word64' integer            { mkMachWord64 $2 }
 819                 | '__int64' integer             { mkMachInt64 $2 }
 820                 | '__float' rational            { MachFloat $2 }
 821                 | '__addr' integer              { MachAddr $2 }
 822                 | '__label' STRING              { MachLabel $2 }
 823
 824 integer         :: { Integer }
 825                 : INTEGER                       { $1 }
 826                 | '-' INTEGER                   { (-$2) }
 827
 828 rational        :: { Rational }
 829                 : RATIONAL                      { $1 }
 830                 | '-' RATIONAL                  { (-$2) }
 831
 832 core_bndr       :: { UfBinder RdrName }
 833 core_bndr       : core_val_bndr                                 { $1 }
 834                 | core_tv_bndr                                  { $1 }
 835
 836 core_bndrs      :: { [UfBinder RdrName] }
 837 core_bndrs      :                                               { [] }
 838                 | core_bndr core_bndrs                          { $1 : $2 }
 839
 840 core_val_bndr   :: { UfBinder RdrName }
 841 core_val_bndr   : var_name '::' atype                           { UfValBinder $1 $3 }
 842
 843 core_tv_bndr    :: { UfBinder RdrName }
 844 core_tv_bndr    :  '@' tv_name '::' akind               { UfTyBinder $2 $4 }
 845                 |  '@' tv_name                          { UfTyBinder $2 liftedTypeKind }
 846
 847 ccall_string    :: { FAST_STRING }
 848                 : STRING                                        { $1 }
 849                 | CLITLIT                                       { $1 }
 850                 | VARID                                         { $1 }
 851                 | CONID                                         { $1 }
 852
 853 ------------------------------------------------------------------------
 854 scc     :: { CostCentre }
 855         :  '__sccC' '{' mod_name '}'                      { AllCafsCC $3 }
 856         |  '__scc' '{' cc_name mod_name cc_dup cc_caf '}'
 857                              { NormalCC { cc_name = $3, cc_mod = $4,
 858                                           cc_is_dupd = $5, cc_is_caf = $6 } }
 859
 860 cc_name :: { EncodedFS }
 861         : CONID                 { $1 }
 862         | var_fs                { $1 }
 863
 864 cc_dup  :: { IsDupdCC }
 865 cc_dup  :                       { OriginalCC }
 866         | '!'                   { DupdCC }
 867
 868 cc_caf  :: { IsCafCC }
 869         :                       { NotCafCC }
 870         | '__C'                 { CafCC }
 871
 872 -------------------------------------------------------------------
 873
 874 src_loc :: { SrcLoc }
 875 src_loc :                               {% getSrcLocP }
 876
 877 -- Check the project version: this makes sure
 878 -- that the project version (e.g. 407) in the interface
 879 -- file is the same as that for the compiler that's reading it
 880 checkVersion :: { () }
 881            : {-empty-}                  {% checkVersion Nothing }
 882            | INTEGER                    {% checkVersion (Just (fromInteger $1)) }
 883
 884 -------------------------------------------------------------------
 885
 886 --                      Haskell code
 887 {
 888 happyError :: P a
 889 happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
 890
 891 mk_con_decl name (ex_tvs, ex_ctxt) details loc = mkConDecl name ex_tvs ex_ctxt details loc
 892 }