ghc/compiler/parser/Parser.y.pp

   1 --                                                              -*-haskell-*-
   2 -- ---------------------------------------------------------------------------
   3 -- (c) The University of Glasgow 1997-2003
   4 ---
   5 -- The GHC grammar.
   6 --
   7 -- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
   8 -- ---------------------------------------------------------------------------
   9
  10 {
  11 module Parser ( parseModule, parseStmt, parseIdentifier, parseIface ) where
  12
  13 #define INCLUDE #include
  14 INCLUDE "HsVersions.h"
  15
  16 import HsSyn
  17 import RdrHsSyn
  18 import HscTypes         ( ModIface, IsBootInterface, DeprecTxt )
  19 import Lexer
  20 import RdrName
  21 import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
  22                           listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
  23 import Type             ( funTyCon )
  24 import ForeignCall      ( Safety(..), CExportSpec(..),
  25                           CCallConv(..), CCallTarget(..), defaultCCallConv
  26                         )
  27 import OccName          ( UserFS, varName, dataName, tcClsName, tvName )
  28 import DataCon          ( DataCon, dataConName )
  29 import SrcLoc           ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
  30                           SrcSpan, combineLocs, mkGeneralSrcSpan, srcLocFile )
  31 import Module
  32 import CmdLineOpts      ( opt_SccProfilingOn )
  33 import Type             ( Kind, mkArrowKind, liftedTypeKind )
  34 import BasicTypes       ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
  35                           NewOrData(..), Activation(..) )
  36 import Bag              ( emptyBag )
  37 import Panic
  38
  39 import GLAEXTS
  40 import CStrings         ( CLabelString )
  41 import FastString
  42 import Maybes           ( orElse )
  43 import Outputable
  44 }
  45
  46 {-
  47 -----------------------------------------------------------------------------
  48 Conflicts: 29 shift/reduce, [SDM 19/9/2002]
  49
  50 10 for abiguity in 'if x then y else z + 1'             [State 136]
  51         (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
  52         10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
  53
  54 1 for ambiguity in 'if x then y else z with ?x=3'       [State 136]
  55         (shift parses as 'if x then y else (z with ?x=3)'
  56
  57 1 for ambiguity in 'if x then y else z :: T'            [State 136]
  58         (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
  59
  60 8 for ambiguity in 'e :: a `b` c'.  Does this mean      [States 160,246]
  61         (e::a) `b` c, or
  62         (e :: (a `b` c))
  63
  64 1 for ambiguity in 'let ?x ...'                         [State 268]
  65         the parser can't tell whether the ?x is the lhs of a normal binding or
  66         an implicit binding.  Fortunately resolving as shift gives it the only
  67         sensible meaning, namely the lhs of an implicit binding.
  68
  69 1 for ambiguity in '{-# RULES "name" [ ... #-}          [State 332]
  70         we don't know whether the '[' starts the activation or not: it
  71         might be the start of the declaration with the activation being
  72         empty.  --SDM 1/4/2002
  73
  74 1 for ambiguity in '{-# RULES "name" forall = ... #-}'  [State 394]
  75         since 'forall' is a valid variable name, we don't know whether
  76         to treat a forall on the input as the beginning of a quantifier
  77         or the beginning of the rule itself.  Resolving to shift means
  78         it's always treated as a quantifier, hence the above is disallowed.
  79         This saves explicitly defining a grammar for the rule lhs that
  80         doesn't include 'forall'.
  81
  82 6 for conflicts between `fdecl' and `fdeclDEPRECATED',  [States 384,385]
  83         which are resolved correctly, and moreover,
  84         should go away when `fdeclDEPRECATED' is removed.
  85
  86 -- ---------------------------------------------------------------------------
  87 -- Adding location info
  88
  89 This is done in a stylised way using the three macros below, L0, L1
  90 and LL.  Each of these macros can be thought of as having type
  91
  92    L0, L1, LL :: a -> Located a
  93
  94 They each add a SrcSpan to their argument.
  95
  96    L0   adds 'noSrcSpan', used for empty productions
  97
  98    L1   for a production with a single token on the lhs.  Grabs the SrcSpan
  99         from that token.
 100
 101    LL   for a production with >1 token on the lhs.  Makes up a SrcSpan from
 102         the first and last tokens.
 103
 104 These suffice for the majority of cases.  However, we must be
 105 especially careful with empty productions: LL won't work if the first
 106 or last token on the lhs can represent an empty span.  In these cases,
 107 we have to calculate the span using more of the tokens from the lhs, eg.
 108
 109         | 'newtype' tycl_hdr '=' newconstr deriving
 110                 { L (comb3 $1 $4 $5)
 111                     (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
 112
 113 We provide comb3 and comb4 functions which are useful in such cases.
 114
 115 Be careful: there's no checking that you actually got this right, the
 116 only symptom will be that the SrcSpans of your syntax will be
 117 incorrect.
 118
 119 /*
 120  * We must expand these macros *before* running Happy, which is why this file is
 121  * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
 122  */
 123 #define L0   L noSrcSpan
 124 #define L1   sL (getLoc $1)
 125 #define LL   sL (comb2 $1 $>)
 126
 127 -- -----------------------------------------------------------------------------
 128
 129 -}
 130
 131 %token
 132  '_'            { L _ ITunderscore }            -- Haskell keywords
 133  'as'           { L _ ITas }
 134  'case'         { L _ ITcase }
 135  'class'        { L _ ITclass }
 136  'data'         { L _ ITdata }
 137  'default'      { L _ ITdefault }
 138  'deriving'     { L _ ITderiving }
 139  'do'           { L _ ITdo }
 140  'else'         { L _ ITelse }
 141  'hiding'       { L _ IThiding }
 142  'if'           { L _ ITif }
 143  'import'       { L _ ITimport }
 144  'in'           { L _ ITin }
 145  'infix'        { L _ ITinfix }
 146  'infixl'       { L _ ITinfixl }
 147  'infixr'       { L _ ITinfixr }
 148  'instance'     { L _ ITinstance }
 149  'let'          { L _ ITlet }
 150  'module'       { L _ ITmodule }
 151  'newtype'      { L _ ITnewtype }
 152  'of'           { L _ ITof }
 153  'qualified'    { L _ ITqualified }
 154  'then'         { L _ ITthen }
 155  'type'         { L _ ITtype }
 156  'where'        { L _ ITwhere }
 157  '_scc_'        { L _ ITscc }         -- ToDo: remove
 158
 159  'forall'       { L _ ITforall }                        -- GHC extension keywords
 160  'foreign'      { L _ ITforeign }
 161  'export'       { L _ ITexport }
 162  'label'        { L _ ITlabel }
 163  'dynamic'      { L _ ITdynamic }
 164  'safe'         { L _ ITsafe }
 165  'threadsafe'   { L _ ITthreadsafe }
 166  'unsafe'       { L _ ITunsafe }
 167  'mdo'          { L _ ITmdo }
 168  'stdcall'      { L _ ITstdcallconv }
 169  'ccall'        { L _ ITccallconv }
 170  'dotnet'       { L _ ITdotnet }
 171  'proc'         { L _ ITproc }          -- for arrow notation extension
 172  'rec'          { L _ ITrec }           -- for arrow notation extension
 173
 174  '{-# SPECIALISE'  { L _ ITspecialise_prag }
 175  '{-# SOURCE'      { L _ ITsource_prag }
 176  '{-# INLINE'      { L _ ITinline_prag }
 177  '{-# NOINLINE'    { L _ ITnoinline_prag }
 178  '{-# RULES'       { L _ ITrules_prag }
 179  '{-# CORE'        { L _ ITcore_prag }              -- hdaume: annotated core
 180  '{-# SCC'         { L _ ITscc_prag }
 181  '{-# DEPRECATED'  { L _ ITdeprecated_prag }
 182  '{-# UNPACK'      { L _ ITunpack_prag }
 183  '#-}'             { L _ ITclose_prag }
 184
 185  '..'           { L _ ITdotdot }                        -- reserved symbols
 186  ':'            { L _ ITcolon }
 187  '::'           { L _ ITdcolon }
 188  '='            { L _ ITequal }
 189  '\\'           { L _ ITlam }
 190  '|'            { L _ ITvbar }
 191  '<-'           { L _ ITlarrow }
 192  '->'           { L _ ITrarrow }
 193  '@'            { L _ ITat }
 194  '~'            { L _ ITtilde }
 195  '=>'           { L _ ITdarrow }
 196  '-'            { L _ ITminus }
 197  '!'            { L _ ITbang }
 198  '*'            { L _ ITstar }
 199  '-<'           { L _ ITlarrowtail }            -- for arrow notation
 200  '>-'           { L _ ITrarrowtail }            -- for arrow notation
 201  '-<<'          { L _ ITLarrowtail }            -- for arrow notation
 202  '>>-'          { L _ ITRarrowtail }            -- for arrow notation
 203  '.'            { L _ ITdot }
 204
 205  '{'            { L _ ITocurly }                        -- special symbols
 206  '}'            { L _ ITccurly }
 207  '{|'           { L _ ITocurlybar }
 208  '|}'           { L _ ITccurlybar }
 209  vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
 210  vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
 211  '['            { L _ ITobrack }
 212  ']'            { L _ ITcbrack }
 213  '[:'           { L _ ITopabrack }
 214  ':]'           { L _ ITcpabrack }
 215  '('            { L _ IToparen }
 216  ')'            { L _ ITcparen }
 217  '(#'           { L _ IToubxparen }
 218  '#)'           { L _ ITcubxparen }
 219  '(|'           { L _ IToparenbar }
 220  '|)'           { L _ ITcparenbar }
 221  ';'            { L _ ITsemi }
 222  ','            { L _ ITcomma }
 223  '`'            { L _ ITbackquote }
 224
 225  VARID          { L _ (ITvarid    _) }          -- identifiers
 226  CONID          { L _ (ITconid    _) }
 227  VARSYM         { L _ (ITvarsym   _) }
 228  CONSYM         { L _ (ITconsym   _) }
 229  QVARID         { L _ (ITqvarid   _) }
 230  QCONID         { L _ (ITqconid   _) }
 231  QVARSYM        { L _ (ITqvarsym  _) }
 232  QCONSYM        { L _ (ITqconsym  _) }
 233
 234  IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
 235  IPSPLITVARID   { L _ (ITsplitipvarid _) }              -- GHC extension
 236
 237  CHAR           { L _ (ITchar     _) }
 238  STRING         { L _ (ITstring   _) }
 239  INTEGER        { L _ (ITinteger  _) }
 240  RATIONAL       { L _ (ITrational _) }
 241
 242  PRIMCHAR       { L _ (ITprimchar   _) }
 243  PRIMSTRING     { L _ (ITprimstring _) }
 244  PRIMINTEGER    { L _ (ITprimint    _) }
 245  PRIMFLOAT      { L _ (ITprimfloat  _) }
 246  PRIMDOUBLE     { L _ (ITprimdouble _) }
 247
 248 -- Template Haskell
 249 '[|'            { L _ ITopenExpQuote  }
 250 '[p|'           { L _ ITopenPatQuote  }
 251 '[t|'           { L _ ITopenTypQuote  }
 252 '[d|'           { L _ ITopenDecQuote  }
 253 '|]'            { L _ ITcloseQuote    }
 254 TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
 255 '$('            { L _ ITparenEscape   }     -- $( exp )
 256 TH_VAR_QUOTE    { L _ ITvarQuote      }     -- 'x
 257 TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
 258
 259 %monad { P } { >>= } { return }
 260 %lexer { lexer } { L _ ITeof }
 261 %name parseModule module
 262 %name parseStmt   maybe_stmt
 263 %name parseIdentifier  identifier
 264 %name parseIface iface
 265 %tokentype { Located Token }
 266 %%
 267
 268 -----------------------------------------------------------------------------
 269 -- Module Header
 270
 271 -- The place for module deprecation is really too restrictive, but if it
 272 -- was allowed at its natural place just before 'module', we get an ugly
 273 -- s/r conflict with the second alternative. Another solution would be the
 274 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
 275 -- either, and DEPRECATED is only expected to be used by people who really
 276 -- know what they are doing. :-)
 277
 278 module  :: { Located (HsModule RdrName) }
 279         : 'module' modid maybemoddeprec maybeexports 'where' body
 280                 {% fileSrcSpan >>= \ loc ->
 281                    return (L loc (HsModule (Just (L (getLoc $2)
 282                                         (mkHomeModule (unLoc $2))))
 283                                 $4 (fst $6) (snd $6) $3)) }
 284         | missing_module_keyword top close
 285                 {% fileSrcSpan >>= \ loc ->
 286                    return (L loc (HsModule Nothing Nothing
 287                                 (fst $2) (snd $2) Nothing)) }
 288
 289 missing_module_keyword :: { () }
 290         : {- empty -}                           {% pushCurrentContext }
 291
 292 maybemoddeprec :: { Maybe DeprecTxt }
 293         : '{-# DEPRECATED' STRING '#-}'         { Just (getSTRING $2) }
 294         |  {- empty -}                          { Nothing }
 295
 296 body    :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
 297         :  '{'            top '}'               { $2 }
 298         |      vocurly    top close             { $2 }
 299
 300 top     :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
 301         : importdecls                           { (reverse $1,[]) }
 302         | importdecls ';' cvtopdecls            { (reverse $1,$3) }
 303         | cvtopdecls                            { ([],$1) }
 304
 305 cvtopdecls :: { [LHsDecl RdrName] }
 306         : topdecls                              { cvTopDecls $1 }
 307
 308 -----------------------------------------------------------------------------
 309 -- Interfaces (.hi-boot files)
 310
 311 iface   :: { ModIface }
 312         : 'module' modid 'where' ifacebody  { mkBootIface (unLoc $2) $4 }
 313
 314 ifacebody :: { [HsDecl RdrName] }
 315         :  '{'            ifacedecls '}'                { $2 }
 316         |      vocurly    ifacedecls close              { $2 }
 317
 318 ifacedecls :: { [HsDecl RdrName] }
 319         : ifacedecl ';' ifacedecls      { $1 : $3 }
 320         | ';' ifacedecls                { $2 }
 321         | ifacedecl                     { [$1] }
 322         | {- empty -}                   { [] }
 323
 324 ifacedecl :: { HsDecl RdrName }
 325         : var '::' sigtype
 326                 { SigD (Sig $1 $3) }
 327         | 'type' syn_hdr '=' ctype
 328                 { let (tc,tvs) = $2 in TyClD (TySynonym tc tvs $4) }
 329         | 'data' tycl_hdr
 330                 { TyClD (mkTyData DataType (unLoc $2) [] Nothing) }
 331         | 'newtype' tycl_hdr
 332                 { TyClD (mkTyData NewType (unLoc $2) [] Nothing) }
 333         | 'class' tycl_hdr fds
 334                 { TyClD (mkClassDecl (unLoc $2) (unLoc $3) [] emptyBag) }
 335
 336 -----------------------------------------------------------------------------
 337 -- The Export List
 338
 339 maybeexports :: { Maybe [LIE RdrName] }
 340         :  '(' exportlist ')'                   { Just $2 }
 341         |  {- empty -}                          { Nothing }
 342
 343 exportlist :: { [LIE RdrName] }
 344         :  exportlist ',' export                { $3 : $1 }
 345         |  exportlist ','                       { $1 }
 346         |  export                               { [$1]  }
 347         |  {- empty -}                          { [] }
 348
 349    -- No longer allow things like [] and (,,,) to be exported
 350    -- They are built in syntax, always available
 351 export  :: { LIE RdrName }
 352         :  qvar                         { L1 (IEVar (unLoc $1)) }
 353         |  oqtycon                      { L1 (IEThingAbs (unLoc $1)) }
 354         |  oqtycon '(' '..' ')'         { LL (IEThingAll (unLoc $1)) }
 355         |  oqtycon '(' ')'              { LL (IEThingWith (unLoc $1) []) }
 356         |  oqtycon '(' qcnames ')'      { LL (IEThingWith (unLoc $1) (reverse $3)) }
 357         |  'module' modid               { LL (IEModuleContents (unLoc $2)) }
 358
 359 qcnames :: { [RdrName] }
 360         :  qcnames ',' qcname                   { unLoc $3 : $1 }
 361         |  qcname                               { [unLoc $1]  }
 362
 363 qcname  :: { Located RdrName }  -- Variable or data constructor
 364         :  qvar                                 { $1 }
 365         |  gcon                                 { $1 }
 366
 367 -----------------------------------------------------------------------------
 368 -- Import Declarations
 369
 370 -- import decls can be *empty*, or even just a string of semicolons
 371 -- whereas topdecls must contain at least one topdecl.
 372
 373 importdecls :: { [LImportDecl RdrName] }
 374         : importdecls ';' importdecl            { $3 : $1 }
 375         | importdecls ';'                       { $1 }
 376         | importdecl                            { [ $1 ] }
 377         | {- empty -}                           { [] }
 378
 379 importdecl :: { LImportDecl RdrName }
 380         : 'import' maybe_src optqualified modid maybeas maybeimpspec
 381                 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
 382
 383 maybe_src :: { IsBootInterface }
 384         : '{-# SOURCE' '#-}'                    { True }
 385         | {- empty -}                           { False }
 386
 387 optqualified :: { Bool }
 388         : 'qualified'                           { True  }
 389         | {- empty -}                           { False }
 390
 391 maybeas :: { Located (Maybe ModuleName) }
 392         : 'as' modid                            { LL (Just (unLoc $2)) }
 393         | {- empty -}                           { noLoc Nothing }
 394
 395 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
 396         : impspec                               { L1 (Just (unLoc $1)) }
 397         | {- empty -}                           { noLoc Nothing }
 398
 399 impspec :: { Located (Bool, [LIE RdrName]) }
 400         :  '(' exportlist ')'                   { LL (False, reverse $2) }
 401         |  'hiding' '(' exportlist ')'          { LL (True,  reverse $3) }
 402
 403 -----------------------------------------------------------------------------
 404 -- Fixity Declarations
 405
 406 prec    :: { Int }
 407         : {- empty -}           { 9 }
 408         | INTEGER               {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
 409
 410 infix   :: { Located FixityDirection }
 411         : 'infix'                               { L1 InfixN  }
 412         | 'infixl'                              { L1 InfixL  }
 413         | 'infixr'                              { L1 InfixR }
 414
 415 ops     :: { Located [Located RdrName] }
 416         : ops ',' op                            { LL ($3 : unLoc $1) }
 417         | op                                    { L1 [$1] }
 418
 419 -----------------------------------------------------------------------------
 420 -- Top-Level Declarations
 421
 422 topdecls :: { [RdrBinding] }    -- Reversed
 423         : topdecls ';' topdecl          { $3 : $1 }
 424         | topdecls ';'                  { $1 }
 425         | topdecl                       { [$1] }
 426
 427 topdecl :: { RdrBinding }
 428         : tycl_decl                     { RdrHsDecl (L1 (TyClD (unLoc $1))) }
 429         | 'instance' inst_type where
 430                 { let (binds,sigs) = cvBindsAndSigs (unLoc $3)
 431                   in RdrHsDecl (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
 432         | 'default' '(' comma_types0 ')'        { RdrHsDecl (LL $ DefD (DefaultDecl $3)) }
 433         | 'foreign' fdecl                       { RdrHsDecl (LL (unLoc $2)) }
 434         | '{-# DEPRECATED' deprecations '#-}'   { RdrBindings (reverse $2) }
 435         | '{-# RULES' rules '#-}'               { RdrBindings (reverse $2) }
 436         | '$(' exp ')'                          { RdrHsDecl (LL $ SpliceD (SpliceDecl $2)) }
 437         | decl                                  { unLoc $1 }
 438
 439 tycl_decl :: { LTyClDecl RdrName }
 440         : 'type' syn_hdr '=' ctype
 441                 -- Note ctype, not sigtype.
 442                 -- We allow an explicit for-all but we don't insert one
 443                 -- in   type Foo a = (b,b)
 444                 -- Instead we just say b is out of scope
 445                 { LL $ let (tc,tvs) = $2 in TySynonym tc tvs $4 }
 446
 447         | 'data' tycl_hdr constrs deriving
 448                 { L (comb4 $1 $2 $3 $4)
 449                     (mkTyData DataType (unLoc $2) (reverse (unLoc $3)) (unLoc $4)) }
 450
 451         | 'newtype' tycl_hdr '=' newconstr deriving
 452                 { L (comb3 $1 $4 $5)
 453                     (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
 454
 455         | 'class' tycl_hdr fds where
 456                 { let
 457                         (binds,sigs) = cvBindsAndSigs (unLoc $4)
 458                   in
 459                   L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs
 460                                           binds) }
 461
 462 syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) }
 463                 -- We don't retain the syntax of an infix
 464                 -- type synonym declaration. Oh well.
 465         : tycon tv_bndrs                { ($1, $2) }
 466         | tv_bndr tyconop tv_bndr       { ($2, [$1,$3]) }
 467
 468 -- tycl_hdr parses the header of a type or class decl,
 469 -- which takes the form
 470 --      T a b
 471 --      Eq a => T a
 472 --      (Eq a, Ord b) => T a b
 473 -- Rather a lot of inlining here, else we get reduce/reduce errors
 474 tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
 475         : context '=>' type             {% checkTyClHdr $1 $3 >>= return.LL }
 476         | type                          {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
 477
 478 -----------------------------------------------------------------------------
 479 -- Nested declarations
 480
 481 decls   :: { Located [RdrBinding] }     -- Reversed
 482         : decls ';' decl                { LL (unLoc $3 : unLoc $1) }
 483         | decls ';'                     { LL (unLoc $1) }
 484         | decl                          { L1 [unLoc $1] }
 485         | {- empty -}                   { noLoc [] }
 486
 487
 488 decllist :: { Located [RdrBinding] }    -- Reversed
 489         : '{'            decls '}'      { LL (unLoc $2) }
 490         |     vocurly    decls close    { $2 }
 491
 492 where   :: { Located [RdrBinding] }     -- Reversed
 493                                 -- No implicit parameters
 494         : 'where' decllist              { LL (unLoc $2) }
 495         | {- empty -}                   { noLoc [] }
 496
 497 binds   ::  { Located [HsBindGroup RdrName] }   -- May have implicit parameters
 498         : decllist                      { L1 [cvBindGroup (unLoc $1)] }
 499         | '{'            dbinds '}'     { LL [HsIPBinds (unLoc $2)] }
 500         |     vocurly    dbinds close   { L (getLoc $2) [HsIPBinds (unLoc $2)] }
 501
 502 wherebinds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
 503         : 'where' binds                 { LL (unLoc $2) }
 504         | {- empty -}                   { noLoc [] }
 505
 506
 507 -----------------------------------------------------------------------------
 508 -- Transformation Rules
 509
 510 rules   :: { [RdrBinding] }     -- Reversed
 511         :  rules ';' rule                       { $3 : $1 }
 512         |  rules ';'                            { $1 }
 513         |  rule                                 { [$1] }
 514         |  {- empty -}                          { [] }
 515
 516 rule    :: { RdrBinding }
 517         : STRING activation rule_forall infixexp '=' exp
 518              { RdrHsDecl (LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6)) }
 519
 520 activation :: { Activation }           -- Omitted means AlwaysActive
 521         : {- empty -}                           { AlwaysActive }
 522         | explicit_activation                   { $1 }
 523
 524 inverse_activation :: { Activation }   -- Omitted means NeverActive
 525         : {- empty -}                           { NeverActive }
 526         | explicit_activation                   { $1 }
 527
 528 explicit_activation :: { Activation }  -- In brackets
 529         : '[' INTEGER ']'               { ActiveAfter  (fromInteger (getINTEGER $2)) }
 530         | '[' '~' INTEGER ']'           { ActiveBefore (fromInteger (getINTEGER $3)) }
 531
 532 rule_forall :: { [RuleBndr RdrName] }
 533         : 'forall' rule_var_list '.'            { $2 }
 534         | {- empty -}                           { [] }
 535
 536 rule_var_list :: { [RuleBndr RdrName] }
 537         : rule_var                              { [$1] }
 538         | rule_var rule_var_list                { $1 : $2 }
 539
 540 rule_var :: { RuleBndr RdrName }
 541         : varid                                 { RuleBndr $1 }
 542         | '(' varid '::' ctype ')'              { RuleBndrSig $2 $4 }
 543
 544 -----------------------------------------------------------------------------
 545 -- Deprecations (c.f. rules)
 546
 547 deprecations :: { [RdrBinding] }        -- Reversed
 548         : deprecations ';' deprecation          { $3 : $1 }
 549         | deprecations ';'                      { $1 }
 550         | deprecation                           { [$1] }
 551         | {- empty -}                           { [] }
 552
 553 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 554 deprecation :: { RdrBinding }
 555         : depreclist STRING
 556                 { RdrBindings [ RdrHsDecl (LL $ DeprecD (Deprecation n (getSTRING $2))) | n <- unLoc $1 ] }
 557
 558
 559 -----------------------------------------------------------------------------
 560 -- Foreign import and export declarations
 561
 562 -- for the time being, the following accepts foreign declarations conforming
 563 -- to the FFI Addendum, Version 1.0 as well as pre-standard declarations
 564 --
 565 -- * a flag indicates whether pre-standard declarations have been used and
 566 --   triggers a deprecation warning further down the road
 567 --
 568 -- NB: The first two rules could be combined into one by replacing `safety1'
 569 --     with `safety'.  However, the combined rule conflicts with the
 570 --     DEPRECATED rules.
 571 --
 572 fdecl :: { LHsDecl RdrName }
 573 fdecl : 'import' callconv safety1 fspec
 574                 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
 575       | 'import' callconv         fspec
 576                 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
 577                         return (LL d) } }
 578       | 'export' callconv fspec
 579                 {% mkExport $2 (unLoc $3) >>= return.LL }
 580         -- the following syntax is DEPRECATED
 581       | fdecl1DEPRECATED                        { L1 (ForD (unLoc $1)) }
 582       | fdecl2DEPRECATED                        { L1 (unLoc $1) }
 583
 584 fdecl1DEPRECATED :: { LForeignDecl RdrName }
 585 fdecl1DEPRECATED
 586   ----------- DEPRECATED label decls ------------
 587   : 'label' ext_name varid '::' sigtype
 588     { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
 589                                    (CLabel ($2 `orElse` mkExtName (unLoc $3)))) True }
 590
 591   ----------- DEPRECATED ccall/stdcall decls ------------
 592   --
 593   -- NB: This business with the case expression below may seem overly
 594   --     complicated, but it is necessary to avoid some conflicts.
 595
 596     -- DEPRECATED variant #1: lack of a calling convention specification
 597     --                        (import)
 598   | 'import' {-no callconv-} ext_name safety varid_no_unsafe '::' sigtype
 599     { let
 600         target = StaticTarget ($2 `orElse` mkExtName (unLoc $4))
 601       in
 602       LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
 603                                    (CFunction target)) True }
 604
 605     -- DEPRECATED variant #2: external name consists of two separate strings
 606     --                        (module name and function name) (import)
 607   | 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype
 608     {% case $2 of
 609          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 610          CCall cconv -> return $
 611            let
 612              imp = CFunction (StaticTarget (getSTRING $4))
 613            in
 614            LL $ ForeignImport $6 $8 (CImport cconv $5 nilFS nilFS imp) True }
 615
 616     -- DEPRECATED variant #3: `unsafe' after entity
 617   | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype
 618     {% case $2 of
 619          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 620          CCall cconv -> return $
 621            let
 622              imp = CFunction (StaticTarget (getSTRING $3))
 623            in
 624            LL $ ForeignImport $5 $7 (CImport cconv PlayRisky nilFS nilFS imp) True }
 625
 626     -- DEPRECATED variant #4: use of the special identifier `dynamic' without
 627     --                        an explicit calling convention (import)
 628   | 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype
 629     { LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
 630                                    (CFunction DynamicTarget)) True }
 631
 632     -- DEPRECATED variant #5: use of the special identifier `dynamic' (import)
 633   | 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype
 634     {% case $2 of
 635          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 636          CCall cconv -> return $
 637            LL $ ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS
 638                                         (CFunction DynamicTarget)) True }
 639
 640     -- DEPRECATED variant #6: lack of a calling convention specification
 641     --                        (export)
 642   | 'export' {-no callconv-} ext_name varid '::' sigtype
 643     { LL $ ForeignExport $3 $5 (CExport (CExportStatic ($2 `orElse` mkExtName (unLoc $3))
 644                                    defaultCCallConv)) True }
 645
 646     -- DEPRECATED variant #7: external name consists of two separate strings
 647     --                        (module name and function name) (export)
 648   | 'export' callconv STRING STRING varid '::' sigtype
 649     {% case $2 of
 650          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 651          CCall cconv -> return $
 652            LL $ ForeignExport $5 $7
 653                          (CExport (CExportStatic (getSTRING $4) cconv)) True }
 654
 655     -- DEPRECATED variant #8: use of the special identifier `dynamic' without
 656     --                        an explicit calling convention (export)
 657   | 'export' {-no callconv-} 'dynamic' varid '::' sigtype
 658     { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
 659                                    CWrapper) True }
 660
 661     -- DEPRECATED variant #9: use of the special identifier `dynamic' (export)
 662   | 'export' callconv 'dynamic' varid '::' sigtype
 663     {% case $2 of
 664          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 665          CCall cconv -> return $
 666            LL $ ForeignImport $4 $6
 667                  (CImport cconv (PlaySafe False) nilFS nilFS CWrapper) True }
 668
 669   ----------- DEPRECATED .NET decls ------------
 670   -- NB: removed the .NET call declaration, as it is entirely subsumed
 671   --     by the new standard FFI declarations
 672
 673 fdecl2DEPRECATED :: { LHsDecl RdrName }
 674 fdecl2DEPRECATED
 675   : 'import' 'dotnet' 'type' ext_name tycon { LL $ TyClD (ForeignType $5 $4 DNType) }
 676     -- left this one unchanged for the moment as type imports are not
 677     -- covered currently by the FFI standard -=chak
 678
 679
 680 callconv :: { CallConv }
 681           : 'stdcall'                   { CCall  StdCallConv }
 682           | 'ccall'                     { CCall  CCallConv   }
 683           | 'dotnet'                    { DNCall             }
 684
 685 safety :: { Safety }
 686         : 'unsafe'                      { PlayRisky }
 687         | 'safe'                        { PlaySafe False }
 688         | 'threadsafe'                  { PlaySafe True  }
 689         | {- empty -}                   { PlaySafe False }
 690
 691 safety1 :: { Safety }
 692         : 'unsafe'                      { PlayRisky }
 693         | 'safe'                        { PlaySafe  False }
 694         | 'threadsafe'                  { PlaySafe  True }
 695           -- only needed to avoid conflicts with the DEPRECATED rules
 696
 697 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
 698        : STRING var '::' sigtype      { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
 699        |        var '::' sigtype      { LL (noLoc nilFS, $1, $3) }
 700          -- if the entity string is missing, it defaults to the empty string;
 701          -- the meaning of an empty entity string depends on the calling
 702          -- convention
 703
 704 -- DEPRECATED syntax
 705 ext_name :: { Maybe CLabelString }
 706         : STRING                { Just (getSTRING $1) }
 707         | STRING STRING         { Just (getSTRING $2) } -- Ignore "module name" for now
 708         | {- empty -}           { Nothing }
 709
 710
 711 -----------------------------------------------------------------------------
 712 -- Type signatures
 713
 714 opt_sig :: { Maybe (LHsType RdrName) }
 715         : {- empty -}                   { Nothing }
 716         | '::' sigtype                  { Just $2 }
 717
 718 opt_asig :: { Maybe (LHsType RdrName) }
 719         : {- empty -}                   { Nothing }
 720         | '::' atype                    { Just $2 }
 721
 722 sigtypes :: { [LHsType RdrName] }
 723         : sigtype                       { [ $1 ] }
 724         | sigtypes ',' sigtype          { $3 : $1 }
 725
 726 sigtype :: { LHsType RdrName }
 727         : ctype                         { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
 728         -- Wrap an Implicit forall if there isn't one there already
 729
 730 sig_vars :: { Located [Located RdrName] }
 731          : sig_vars ',' var             { LL ($3 : unLoc $1) }
 732          | var                          { L1 [$1] }
 733
 734 -----------------------------------------------------------------------------
 735 -- Types
 736
 737 -- A ctype is a for-all type
 738 ctype   :: { LHsType RdrName }
 739         : 'forall' tv_bndrs '.' ctype   { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
 740         | context '=>' type             { LL $ mkImplicitHsForAllTy   $1 $3 }
 741         -- A type of form (context => type) is an *implicit* HsForAllTy
 742         | type                          { $1 }
 743
 744 -- We parse a context as a btype so that we don't get reduce/reduce
 745 -- errors in ctype.  The basic problem is that
 746 --      (Eq a, Ord a)
 747 -- looks so much like a tuple type.  We can't tell until we find the =>
 748 context :: { LHsContext RdrName }
 749         : btype                         {% checkContext $1 }
 750
 751 type :: { LHsType RdrName }
 752         : ipvar '::' gentype            { LL (HsPredTy (LL $ HsIParam (unLoc $1) $3)) }
 753         | gentype                       { $1 }
 754
 755 gentype :: { LHsType RdrName }
 756         : btype                         { $1 }
 757         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
 758         | btype  '`' tyvar '`' gentype  { LL $ HsOpTy $1 $3 $5 }
 759         | btype '->' gentype            { LL $ HsFunTy $1 $3 }
 760
 761 btype :: { LHsType RdrName }
 762         : btype atype                   { LL $ HsAppTy $1 $2 }
 763         | atype                         { $1 }
 764
 765 atype :: { LHsType RdrName }
 766         : gtycon                        { L1 (HsTyVar (unLoc $1)) }
 767         | tyvar                         { L1 (HsTyVar (unLoc $1)) }
 768         | '(' type ',' comma_types1 ')' { LL $ HsTupleTy Boxed  ($2:$4) }
 769         | '(#' comma_types1 '#)'        { LL $ HsTupleTy Unboxed $2     }
 770         | '[' type ']'                  { LL $ HsListTy  $2 }
 771         | '[:' type ':]'                { LL $ HsPArrTy  $2 }
 772         | '(' ctype ')'                 { LL $ HsParTy   $2 }
 773         | '(' ctype '::' kind ')'       { LL $ HsKindSig $2 $4 }
 774 -- Generics
 775         | INTEGER                       { L1 (HsNumTy (getINTEGER $1)) }
 776
 777 -- An inst_type is what occurs in the head of an instance decl
 778 --      e.g.  (Foo a, Gaz b) => Wibble a b
 779 -- It's kept as a single type, with a MonoDictTy at the right
 780 -- hand corner, for convenience.
 781 inst_type :: { LHsType RdrName }
 782         : ctype                         {% checkInstType $1 }
 783
 784 comma_types0  :: { [LHsType RdrName] }
 785         : comma_types1                  { $1 }
 786         | {- empty -}                   { [] }
 787
 788 comma_types1    :: { [LHsType RdrName] }
 789         : type                          { [$1] }
 790         | type  ',' comma_types1        { $1 : $3 }
 791
 792 tv_bndrs :: { [LHsTyVarBndr RdrName] }
 793          : tv_bndr tv_bndrs             { $1 : $2 }
 794          | {- empty -}                  { [] }
 795
 796 tv_bndr :: { LHsTyVarBndr RdrName }
 797         : tyvar                         { L1 (UserTyVar (unLoc $1)) }
 798         | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) $4) }
 799
 800 fds :: { Located [Located ([RdrName], [RdrName])] }
 801         : {- empty -}                   { noLoc [] }
 802         | '|' fds1                      { LL (reverse (unLoc $2)) }
 803
 804 fds1 :: { Located [Located ([RdrName], [RdrName])] }
 805         : fds1 ',' fd                   { LL ($3 : unLoc $1) }
 806         | fd                            { L1 [$1] }
 807
 808 fd :: { Located ([RdrName], [RdrName]) }
 809         : varids0 '->' varids0          { L (comb3 $1 $2 $3)
 810                                            (reverse (unLoc $1), reverse (unLoc $3)) }
 811
 812 varids0 :: { Located [RdrName] }
 813         : {- empty -}                   { noLoc [] }
 814         | varids0 tyvar                 { LL (unLoc $2 : unLoc $1) }
 815
 816 -----------------------------------------------------------------------------
 817 -- Kinds
 818
 819 kind    :: { Kind }
 820         : akind                 { $1 }
 821         | akind '->' kind       { mkArrowKind $1 $3 }
 822
 823 akind   :: { Kind }
 824         : '*'                   { liftedTypeKind }
 825         | '(' kind ')'          { $2 }
 826
 827
 828 -----------------------------------------------------------------------------
 829 -- Datatype declarations
 830
 831 newconstr :: { LConDecl RdrName }
 832         : conid atype   { LL $ ConDecl $1 [] (noLoc [])
 833                                 (PrefixCon [(unbangedType $2)]) }
 834         | conid '{' var '::' ctype '}'
 835                         { LL $ ConDecl $1 [] (noLoc [])
 836                                   (RecCon [($3, (unbangedType $5))]) }
 837
 838 constrs :: { Located [LConDecl RdrName] }
 839         : {- empty; a GHC extension -}  { noLoc [] }
 840         | '=' constrs1                  { LL (unLoc $2) }
 841
 842 constrs1 :: { Located [LConDecl RdrName] }
 843         : constrs1 '|' constr           { LL ($3 : unLoc $1) }
 844         | constr                        { L1 [$1] }
 845
 846 constr :: { LConDecl RdrName }
 847         : forall context '=>' constr_stuff
 848                 { let (con,details) = unLoc $4 in
 849                   LL (ConDecl con (unLoc $1) $2 details) }
 850         | forall constr_stuff
 851                 { let (con,details) = unLoc $2 in
 852                   LL (ConDecl con (unLoc $1) (noLoc []) details) }
 853
 854 forall :: { Located [LHsTyVarBndr RdrName] }
 855         : 'forall' tv_bndrs '.'         { LL $2 }
 856         | {- empty -}                   { noLoc [] }
 857
 858 constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
 859         : btype                         {% mkPrefixCon $1 [] >>= return.LL }
 860         | btype bang_atype satypes      {% do { r <- mkPrefixCon $1 ($2 : unLoc $3);
 861                                                 return (L (comb3 $1 $2 $3) r) } }
 862         | oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.LL }
 863         | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
 864         | sbtype conop sbtype           { LL ($2, InfixCon $1 $3) }
 865
 866 bang_atype :: { LBangType RdrName }
 867         : strict_mark atype             { LL (BangType (unLoc $1) $2) }
 868
 869 satypes :: { Located [LBangType RdrName] }
 870         : atype satypes                 { LL (unbangedType $1 : unLoc $2) }
 871         | bang_atype satypes            { LL ($1 : unLoc $2) }
 872         | {- empty -}                   { noLoc [] }
 873
 874 sbtype :: { LBangType RdrName }
 875         : btype                         { unbangedType $1 }
 876         | strict_mark atype             { LL (BangType (unLoc $1) $2) }
 877
 878 fielddecls :: { [([Located RdrName], LBangType RdrName)] }
 879         : fielddecl ',' fielddecls      { unLoc $1 : $3 }
 880         | fielddecl                     { [unLoc $1] }
 881
 882 fielddecl :: { Located ([Located RdrName], LBangType RdrName) }
 883         : sig_vars '::' stype           { LL (reverse (unLoc $1), $3) }
 884
 885 stype :: { LBangType RdrName }
 886         : ctype                         { unbangedType $1 }
 887         | strict_mark atype             { LL (BangType (unLoc $1) $2) }
 888
 889 strict_mark :: { Located HsBang }
 890         : '!'                           { L1 HsStrict }
 891         | '{-# UNPACK' '#-}' '!'        { LL HsUnbox }
 892
 893 deriving :: { Located (Maybe (LHsContext RdrName)) }
 894         : {- empty -}                   { noLoc Nothing }
 895         | 'deriving' context            { LL (Just $2) }
 896              -- Glasgow extension: allow partial
 897              -- applications in derivings
 898
 899 -----------------------------------------------------------------------------
 900 -- Value definitions
 901
 902 {- There's an awkward overlap with a type signature.  Consider
 903         f :: Int -> Int = ...rhs...
 904    Then we can't tell whether it's a type signature or a value
 905    definition with a result signature until we see the '='.
 906    So we have to inline enough to postpone reductions until we know.
 907 -}
 908
 909 {-
 910   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
 911   instead of qvar, we get another shift/reduce-conflict. Consider the
 912   following programs:
 913
 914      { (^^) :: Int->Int ; }          Type signature; only var allowed
 915
 916      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
 917                                      qvar allowed (because of instance decls)
 918
 919   We can't tell whether to reduce var to qvar until after we've read the signatures.
 920 -}
 921
 922 decl    :: { Located RdrBinding }
 923         : sigdecl                       { $1 }
 924         | infixexp opt_sig rhs          {% do { r <- checkValDef $1 $2 (unLoc $3);
 925                                                 return (LL $ RdrValBinding (LL r)) } }
 926
 927 rhs     :: { Located (GRHSs RdrName) }
 928         : '=' exp wherebinds    { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) placeHolderType }
 929         | gdrhs wherebinds      { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) placeHolderType }
 930
 931 gdrhs :: { Located [LGRHS RdrName] }
 932         : gdrhs gdrh            { LL ($2 : unLoc $1) }
 933         | gdrh                  { L1 [$1] }
 934
 935 gdrh :: { LGRHS RdrName }
 936         : '|' quals '=' exp     { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) :
 937                                                         unLoc $2)) }
 938
 939 sigdecl :: { Located RdrBinding }
 940         : infixexp '::' sigtype
 941                                 {% do s <- checkValSig $1 $3;
 942                                       return (LL $ RdrHsDecl (LL $ SigD s)) }
 943                 -- See the above notes for why we need infixexp here
 944         | var ',' sig_vars '::' sigtype
 945                                 { LL $ mkSigDecls [ LL $ Sig n $5 | n <- $1 : unLoc $3 ] }
 946         | infix prec ops        { LL $ mkSigDecls [ LL $ FixSig (FixitySig n (Fixity $2 (unLoc $1)))
 947                                              | n <- unLoc $3 ] }
 948         | '{-# INLINE'   activation qvar '#-}'
 949                                 { LL $ RdrHsDecl (LL $ SigD (InlineSig True  $3 $2)) }
 950         | '{-# NOINLINE' inverse_activation qvar '#-}'
 951                                 { LL $ RdrHsDecl (LL $ SigD (InlineSig False $3 $2)) }
 952         | '{-# SPECIALISE' qvar '::' sigtypes '#-}'
 953                                 { LL $ mkSigDecls  [ LL $ SpecSig $2 t | t <- $4] }
 954         | '{-# SPECIALISE' 'instance' inst_type '#-}'
 955                                 { LL $ RdrHsDecl (LL $ SigD (SpecInstSig $3)) }
 956
 957 -----------------------------------------------------------------------------
 958 -- Expressions
 959
 960 exp   :: { LHsExpr RdrName }
 961         : infixexp '::' sigtype         { LL $ ExprWithTySig $1 $3 }
 962         | fexp '-<' exp         { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
 963         | fexp '>-' exp         { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
 964         | fexp '-<<' exp        { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
 965         | fexp '>>-' exp        { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
 966         | infixexp                      { $1 }
 967
 968 infixexp :: { LHsExpr RdrName }
 969         : exp10                         { $1 }
 970         | infixexp qop exp10            { LL (OpApp $1 $2 (panic "fixity") $3) }
 971
 972 exp10 :: { LHsExpr RdrName }
 973         : '\\' aexp aexps opt_asig '->' exp
 974                         {% checkPatterns ($2 : reverse $3) >>= \ ps ->
 975                            return (LL $ HsLam (LL $ Match ps $4
 976                                             (GRHSs (unguardedRHS $6) []
 977                                                         placeHolderType))) }
 978         | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
 979         | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
 980         | 'case' exp 'of' altslist              { LL $ HsCase $2 (unLoc $4) }
 981         | '-' fexp                              { LL $ mkHsNegApp $2 }
 982
 983         | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
 984                                            checkDo loc (unLoc $2)  >>= \ stmts ->
 985                                            return (L loc (mkHsDo DoExpr stmts)) }
 986         | 'mdo' stmtlist                {% let loc = comb2 $1 $2 in
 987                                            checkMDo loc (unLoc $2)  >>= \ stmts ->
 988                                            return (L loc (mkHsDo MDoExpr stmts)) }
 989
 990         | scc_annot exp                         { LL $ if opt_SccProfilingOn
 991                                                         then HsSCC (unLoc $1) $2
 992                                                         else HsPar $2 }
 993
 994         | 'proc' aexp '->' exp
 995                         {% checkPattern $2 >>= \ p ->
 996                            return (LL $ HsProc p (LL $ HsCmdTop $4 []
 997                                                    placeHolderType undefined)) }
 998                                                 -- TODO: is LL right here?
 999
1000         | '{-# CORE' STRING '#-}' exp           { LL $ HsCoreAnn (getSTRING $2) $4 }
1001                                                     -- hdaume: core annotation
1002         | fexp                                  { $1 }
1003
1004 scc_annot :: { Located FastString }
1005         : '_scc_' STRING                        { LL $ getSTRING $2 }
1006         | '{-# SCC' STRING '#-}'                { LL $ getSTRING $2 }
1007
1008 fexp    :: { LHsExpr RdrName }
1009         : fexp aexp                             { LL $ HsApp $1 $2 }
1010         | aexp                                  { $1 }
1011
1012 aexps   :: { [LHsExpr RdrName] }
1013         : aexps aexp                            { $2 : $1 }
1014         | {- empty -}                           { [] }
1015
1016 aexp    :: { LHsExpr RdrName }
1017         : qvar '@' aexp                 { LL $ EAsPat $1 $3 }
1018         | '~' aexp                      { LL $ ELazyPat $2 }
1019         | aexp1                         { $1 }
1020
1021 aexp1   :: { LHsExpr RdrName }
1022         : aexp1 '{' fbinds '}'  {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
1023                                                         (reverse $3);
1024                                         return (LL r) }}
1025         | aexp2                 { $1 }
1026
1027 -- Here was the syntax for type applications that I was planning
1028 -- but there are difficulties (e.g. what order for type args)
1029 -- so it's not enabled yet.
1030 -- But this case *is* used for the left hand side of a generic definition,
1031 -- which is parsed as an expression before being munged into a pattern
1032         | qcname '{|' gentype '|}'      { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1033                                                      (sL (getLoc $3) (HsType $3)) }
1034
1035 aexp2   :: { LHsExpr RdrName }
1036         : ipvar                         { L1 (HsIPVar $! unLoc $1) }
1037         | qcname                        { L1 (HsVar   $! unLoc $1) }
1038         | literal                       { L1 (HsLit   $! unLoc $1) }
1039         | INTEGER                       { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
1040         | RATIONAL                      { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
1041         | '(' exp ')'                   { LL (HsPar $2) }
1042         | '(' exp ',' texps ')'         { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1043         | '(#' texps '#)'               { LL $ ExplicitTuple (reverse $2)      Unboxed }
1044         | '[' list ']'                  { LL (unLoc $2) }
1045         | '[:' parr ':]'                { LL (unLoc $2) }
1046         | '(' infixexp qop ')'          { LL $ SectionL $2 $3 }
1047         | '(' qopm infixexp ')'         { LL $ SectionR $2 $3 }
1048         | '_'                           { L1 EWildPat }
1049
1050         -- MetaHaskell Extension
1051         | TH_ID_SPLICE          { L1 $ mkHsSplice
1052                                         (L1 $ HsVar (mkUnqual varName
1053                                                         (getTH_ID_SPLICE $1))) } -- $x
1054         | '$(' exp ')'          { LL $ mkHsSplice $2 }                            -- $( exp )
1055         | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1056         | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
1057         | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1058         | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
1059         | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }
1060         | '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }
1061         | '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
1062                                            return (LL $ HsBracket (PatBr p)) }
1063         | '[d|' cvtopbody '|]'  { LL $ HsBracket (DecBr (mkGroup $2)) }
1064
1065         -- arrow notation extension
1066         | '(|' aexp2 cmdargs '|)'       { LL $ HsArrForm $2 Nothing (reverse $3) }
1067
1068 cmdargs :: { [LHsCmdTop RdrName] }
1069         : cmdargs acmd                  { $2 : $1 }
1070         | {- empty -}                   { [] }
1071
1072 acmd    :: { LHsCmdTop RdrName }
1073         : aexp2                 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1074
1075 cvtopbody :: { [LHsDecl RdrName] }
1076         :  '{'            cvtopdecls '}'                { $2 }
1077         |      vocurly    cvtopdecls close              { $2 }
1078
1079 texps :: { [LHsExpr RdrName] }
1080         : texps ',' exp                 { $3 : $1 }
1081         | exp                           { [$1] }
1082
1083
1084 -----------------------------------------------------------------------------
1085 -- List expressions
1086
1087 -- The rules below are little bit contorted to keep lexps left-recursive while
1088 -- avoiding another shift/reduce-conflict.
1089
1090 list :: { LHsExpr RdrName }
1091         : exp                   { L1 $ ExplicitList placeHolderType [$1] }
1092         | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1093         | exp '..'              { LL $ ArithSeqIn (From $1) }
1094         | exp ',' exp '..'      { LL $ ArithSeqIn (FromThen $1 $3) }
1095         | exp '..' exp          { LL $ ArithSeqIn (FromTo $1 $3) }
1096         | exp ',' exp '..' exp  { LL $ ArithSeqIn (FromThenTo $1 $3 $5) }
1097         | exp pquals            { LL $ mkHsDo ListComp
1098                                         (reverse (L (getLoc $1) (ResultStmt $1) :
1099                                            unLoc $2)) }
1100
1101 lexps :: { Located [LHsExpr RdrName] }
1102         : lexps ',' exp                 { LL ($3 : unLoc $1) }
1103         | exp ',' exp                   { LL [$3,$1] }
1104
1105 -----------------------------------------------------------------------------
1106 -- List Comprehensions
1107
1108 pquals :: { Located [LStmt RdrName] }   -- Either a singleton ParStmt,
1109                                         -- or a reversed list of Stmts
1110         : pquals1                       { case unLoc $1 of
1111                                             [qs] -> L1 qs
1112                                             qss  -> L1 [L1 (ParStmt stmtss)]
1113                                                  where
1114                                                     stmtss = [ (reverse qs, undefined)
1115                                                              | qs <- qss ]
1116                                         }
1117
1118 pquals1 :: { Located [[LStmt RdrName]] }
1119         : pquals1 '|' quals             { LL (unLoc $3 : unLoc $1) }
1120         | '|' quals                     { L (getLoc $2) [unLoc $2] }
1121
1122 quals :: { Located [LStmt RdrName] }
1123         : quals ',' qual                { LL ($3 : unLoc $1) }
1124         | qual                          { L1 [$1] }
1125
1126 -----------------------------------------------------------------------------
1127 -- Parallel array expressions
1128
1129 -- The rules below are little bit contorted; see the list case for details.
1130 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1131 -- Moreover, we allow explicit arrays with no element (represented by the nil
1132 -- constructor in the list case).
1133
1134 parr :: { LHsExpr RdrName }
1135         :                               { noLoc (ExplicitPArr placeHolderType []) }
1136         | exp                           { L1 $ ExplicitPArr placeHolderType [$1] }
1137         | lexps                         { L1 $ ExplicitPArr placeHolderType
1138                                                        (reverse (unLoc $1)) }
1139         | exp '..' exp                  { LL $ PArrSeqIn (FromTo $1 $3) }
1140         | exp ',' exp '..' exp          { LL $ PArrSeqIn (FromThenTo $1 $3 $5) }
1141         | exp pquals                    { LL $ mkHsDo PArrComp
1142                                             (reverse (L (getLoc $1) (ResultStmt $1) :
1143                                                  unLoc $2))
1144                                         }
1145
1146 -- We are reusing `lexps' and `pquals' from the list case.
1147
1148 -----------------------------------------------------------------------------
1149 -- Case alternatives
1150
1151 altslist :: { Located [LMatch RdrName] }
1152         : '{'            alts '}'       { LL (reverse (unLoc $2)) }
1153         |     vocurly    alts  close    { L (getLoc $2) (reverse (unLoc $2)) }
1154
1155 alts    :: { Located [LMatch RdrName] }
1156         : alts1                         { L1 (unLoc $1) }
1157         | ';' alts                      { LL (unLoc $2) }
1158
1159 alts1   :: { Located [LMatch RdrName] }
1160         : alts1 ';' alt                 { LL ($3 : unLoc $1) }
1161         | alts1 ';'                     { LL (unLoc $1) }
1162         | alt                           { L1 [$1] }
1163
1164 alt     :: { LMatch RdrName }
1165         : infixexp opt_sig alt_rhs      {%  checkPattern $1 >>= \p ->
1166                                             return (LL (Match [p] $2 (unLoc $3))) }
1167
1168 alt_rhs :: { Located (GRHSs RdrName) }
1169         : ralt wherebinds               { LL (GRHSs (unLoc $1) (unLoc $2)
1170                                                  placeHolderType) }
1171
1172 ralt :: { Located [LGRHS RdrName] }
1173         : '->' exp                      { LL (unguardedRHS $2) }
1174         | gdpats                        { L1 (reverse (unLoc $1)) }
1175
1176 gdpats :: { Located [LGRHS RdrName] }
1177         : gdpats gdpat                  { LL ($2 : unLoc $1) }
1178         | gdpat                         { L1 [$1] }
1179
1180 gdpat   :: { LGRHS RdrName }
1181         : '|' quals '->' exp            { let r = L (getLoc $4) (ResultStmt $4)
1182                                           in LL $ GRHS (reverse (r : unLoc $2)) }
1183
1184 -----------------------------------------------------------------------------
1185 -- Statement sequences
1186
1187 stmtlist :: { Located [LStmt RdrName] }
1188         : '{'           stmts '}'       { LL (unLoc $2) }
1189         |     vocurly   stmts close     { $2 }
1190
1191 --      do { ;; s ; s ; ; s ;; }
1192 -- The last Stmt should be a ResultStmt, but that's hard to enforce
1193 -- here, because we need too much lookahead if we see do { e ; }
1194 -- So we use ExprStmts throughout, and switch the last one over
1195 -- in ParseUtils.checkDo instead
1196 stmts :: { Located [LStmt RdrName] }
1197         : stmt stmts_help               { LL ($1 : unLoc $2) }
1198         | ';' stmts                     { LL (unLoc $2) }
1199         | {- empty -}                   { noLoc [] }
1200
1201 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1202         : ';' stmts                     { LL (unLoc $2) }
1203         | {- empty -}                   { noLoc [] }
1204
1205 -- For typing stmts at the GHCi prompt, where
1206 -- the input may consist of just comments.
1207 maybe_stmt :: { Maybe (LStmt RdrName) }
1208         : stmt                          { Just $1 }
1209         | {- nothing -}                 { Nothing }
1210
1211 stmt  :: { LStmt RdrName }
1212         : qual                          { $1 }
1213         | infixexp '->' exp             {% checkPattern $3 >>= \p ->
1214                                            return (LL $ BindStmt p $1) }
1215         | 'rec' stmtlist                { LL $ RecStmt (unLoc $2) undefined undefined undefined }
1216
1217 qual  :: { LStmt RdrName }
1218         : infixexp '<-' exp             {% checkPattern $1 >>= \p ->
1219                                            return (LL $ BindStmt p $3) }
1220         | exp                           { L1 $ ExprStmt $1 placeHolderType }
1221         | 'let' binds                   { LL $ LetStmt (unLoc $2) }
1222
1223 -----------------------------------------------------------------------------
1224 -- Record Field Update/Construction
1225
1226 fbinds  :: { HsRecordBinds RdrName }
1227         : fbinds1                       { $1 }
1228         | {- empty -}                   { [] }
1229
1230 fbinds1 :: { HsRecordBinds RdrName }
1231         : fbinds1 ',' fbind             { $3 : $1 }
1232         | fbind                         { [$1] }
1233
1234 fbind   :: { (Located RdrName, LHsExpr RdrName) }
1235         : qvar '=' exp                  { ($1,$3) }
1236
1237 -----------------------------------------------------------------------------
1238 -- Implicit Parameter Bindings
1239
1240 dbinds  :: { Located [LIPBind RdrName] }
1241         : dbinds ';' dbind              { LL ($3 : unLoc $1) }
1242         | dbinds ';'                    { LL (unLoc $1) }
1243         | dbind                         { L1 [$1] }
1244 --      | {- empty -}                   { [] }
1245
1246 dbind   :: { LIPBind RdrName }
1247 dbind   : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
1248
1249 -----------------------------------------------------------------------------
1250 -- Variables, Constructors and Operators.
1251
1252 identifier :: { Located RdrName }
1253         : qvar                          { $1 }
1254         | gcon                          { $1 }
1255         | qvarop                        { $1 }
1256         | qconop                        { $1 }
1257
1258 depreclist :: { Located [RdrName] }
1259 depreclist : deprec_var                 { L1 [unLoc $1] }
1260            | deprec_var ',' depreclist  { LL (unLoc $1 : unLoc $3) }
1261
1262 deprec_var :: { Located RdrName }
1263 deprec_var : var                        { $1 }
1264            | tycon                      { $1 }
1265
1266 gcon    :: { Located RdrName }  -- Data constructor namespace
1267         : sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1268         | qcon                  { $1 }
1269 -- the case of '[:' ':]' is part of the production `parr'
1270
1271 sysdcon :: { Located DataCon }  -- Wired in data constructors
1272         : '(' ')'               { LL unitDataCon }
1273         | '(' commas ')'        { LL $ tupleCon Boxed $2 }
1274         | '[' ']'               { LL nilDataCon }
1275
1276 var     :: { Located RdrName }
1277         : varid                 { $1 }
1278         | '(' varsym ')'        { LL (unLoc $2) }
1279
1280 qvar    :: { Located RdrName }
1281         : qvarid                { $1 }
1282         | '(' varsym ')'        { LL (unLoc $2) }
1283         | '(' qvarsym1 ')'      { LL (unLoc $2) }
1284 -- We've inlined qvarsym here so that the decision about
1285 -- whether it's a qvar or a var can be postponed until
1286 -- *after* we see the close paren.
1287
1288 ipvar   :: { Located (IPName RdrName) }
1289         : IPDUPVARID            { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
1290         | IPSPLITVARID          { L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
1291
1292 qcon    :: { Located RdrName }
1293         : qconid                { $1 }
1294         | '(' qconsym ')'       { LL (unLoc $2) }
1295
1296 varop   :: { Located RdrName }
1297         : varsym                { $1 }
1298         | '`' varid '`'         { LL (unLoc $2) }
1299
1300 qvarop :: { Located RdrName }
1301         : qvarsym               { $1 }
1302         | '`' qvarid '`'        { LL (unLoc $2) }
1303
1304 qvaropm :: { Located RdrName }
1305         : qvarsym_no_minus      { $1 }
1306         | '`' qvarid '`'        { LL (unLoc $2) }
1307
1308 conop :: { Located RdrName }
1309         : consym                { $1 }
1310         | '`' conid '`'         { LL (unLoc $2) }
1311
1312 qconop :: { Located RdrName }
1313         : qconsym               { $1 }
1314         | '`' qconid '`'        { LL (unLoc $2) }
1315
1316 -----------------------------------------------------------------------------
1317 -- Type constructors
1318
1319 gtycon  :: { Located RdrName }  -- A "general" qualified tycon
1320         : oqtycon                       { $1 }
1321         | '(' ')'                       { LL $ getRdrName unitTyCon }
1322         | '(' commas ')'                { LL $ getRdrName (tupleTyCon Boxed $2) }
1323         | '(' '->' ')'                  { LL $ getRdrName funTyCon }
1324         | '[' ']'                       { LL $ listTyCon_RDR }
1325         | '[:' ':]'                     { LL $ parrTyCon_RDR }
1326
1327 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon
1328         : qtycon                        { $1 }
1329         | '(' qtyconsym ')'             { LL (unLoc $2) }
1330
1331 qtyconop :: { Located RdrName } -- Qualified or unqualified
1332         : qtyconsym                     { $1 }
1333         | '`' qtycon '`'                { LL (unLoc $2) }
1334
1335 tyconop :: { Located RdrName }  -- Unqualified
1336         : tyconsym                      { $1 }
1337         | '`' tycon '`'                 { LL (unLoc $2) }
1338
1339 qtycon :: { Located RdrName }   -- Qualified or unqualified
1340         : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
1341         | tycon                         { $1 }
1342
1343 tycon   :: { Located RdrName }  -- Unqualified
1344         : CONID                         { L1 $! mkUnqual tcClsName (getCONID $1) }
1345
1346 qtyconsym :: { Located RdrName }
1347         : QCONSYM                       { L1 $! mkQual tcClsName (getQCONSYM $1) }
1348         | tyconsym                      { $1 }
1349
1350 tyconsym :: { Located RdrName }
1351         : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1352
1353 -----------------------------------------------------------------------------
1354 -- Any operator
1355
1356 op      :: { Located RdrName }   -- used in infix decls
1357         : varop                 { $1 }
1358         | conop                 { $1 }
1359
1360 qop     :: { LHsExpr RdrName }   -- used in sections
1361         : qvarop                { L1 $ HsVar (unLoc $1) }
1362         | qconop                { L1 $ HsVar (unLoc $1) }
1363
1364 qopm    :: { LHsExpr RdrName }   -- used in sections
1365         : qvaropm               { L1 $ HsVar (unLoc $1) }
1366         | qconop                { L1 $ HsVar (unLoc $1) }
1367
1368 -----------------------------------------------------------------------------
1369 -- VarIds
1370
1371 qvarid :: { Located RdrName }
1372         : varid                 { $1 }
1373         | QVARID                { L1 $ mkQual varName (getQVARID $1) }
1374
1375 varid :: { Located RdrName }
1376         : varid_no_unsafe       { $1 }
1377         | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
1378         | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
1379         | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
1380
1381 varid_no_unsafe :: { Located RdrName }
1382         : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
1383         | special_id            { L1 $! mkUnqual varName (unLoc $1) }
1384         | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
1385
1386 tyvar   :: { Located RdrName }
1387         : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
1388         | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
1389         | 'unsafe'              { L1 $! mkUnqual tvName FSLIT("unsafe") }
1390         | 'safe'                { L1 $! mkUnqual tvName FSLIT("safe") }
1391         | 'threadsafe'          { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1392
1393 -- These special_ids are treated as keywords in various places,
1394 -- but as ordinary ids elsewhere.   'special_id' collects all these
1395 -- except 'unsafe' and 'forall' whose treatment differs depending on context
1396 special_id :: { Located UserFS }
1397 special_id
1398         : 'as'                  { L1 FSLIT("as") }
1399         | 'qualified'           { L1 FSLIT("qualified") }
1400         | 'hiding'              { L1 FSLIT("hiding") }
1401         | 'export'              { L1 FSLIT("export") }
1402         | 'label'               { L1 FSLIT("label")  }
1403         | 'dynamic'             { L1 FSLIT("dynamic") }
1404         | 'stdcall'             { L1 FSLIT("stdcall") }
1405         | 'ccall'               { L1 FSLIT("ccall") }
1406
1407 -----------------------------------------------------------------------------
1408 -- Variables
1409
1410 qvarsym :: { Located RdrName }
1411         : varsym                { $1 }
1412         | qvarsym1              { $1 }
1413
1414 qvarsym_no_minus :: { Located RdrName }
1415         : varsym_no_minus       { $1 }
1416         | qvarsym1              { $1 }
1417
1418 qvarsym1 :: { Located RdrName }
1419 qvarsym1 : QVARSYM              { L1 $ mkQual varName (getQVARSYM $1) }
1420
1421 varsym :: { Located RdrName }
1422         : varsym_no_minus       { $1 }
1423         | '-'                   { L1 $ mkUnqual varName FSLIT("-") }
1424
1425 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1426         : VARSYM                { L1 $ mkUnqual varName (getVARSYM $1) }
1427         | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
1428
1429
1430 -- See comments with special_id
1431 special_sym :: { Located UserFS }
1432 special_sym : '!'       { L1 FSLIT("!") }
1433             | '.'       { L1 FSLIT(".") }
1434             | '*'       { L1 FSLIT("*") }
1435
1436 -----------------------------------------------------------------------------
1437 -- Data constructors
1438
1439 qconid :: { Located RdrName }   -- Qualified or unqualifiedb
1440         : conid                 { $1 }
1441         | QCONID                { L1 $ mkQual dataName (getQCONID $1) }
1442
1443 conid   :: { Located RdrName }
1444         : CONID                 { L1 $ mkUnqual dataName (getCONID $1) }
1445
1446 qconsym :: { Located RdrName }  -- Qualified or unqualified
1447         : consym                { $1 }
1448         | QCONSYM               { L1 $ mkQual dataName (getQCONSYM $1) }
1449
1450 consym :: { Located RdrName }
1451         : CONSYM                { L1 $ mkUnqual dataName (getCONSYM $1) }
1452
1453         -- ':' means only list cons
1454         | ':'                   { L1 $ consDataCon_RDR }
1455
1456
1457 -----------------------------------------------------------------------------
1458 -- Literals
1459
1460 literal :: { Located HsLit }
1461         : CHAR                  { L1 $ HsChar       $ getCHAR $1 }
1462         | STRING                { L1 $ HsString     $ getSTRING $1 }
1463         | PRIMINTEGER           { L1 $ HsIntPrim    $ getPRIMINTEGER $1 }
1464         | PRIMCHAR              { L1 $ HsCharPrim   $ getPRIMCHAR $1 }
1465         | PRIMSTRING            { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1466         | PRIMFLOAT             { L1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
1467         | PRIMDOUBLE            { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1468
1469 -----------------------------------------------------------------------------
1470 -- Layout
1471
1472 close :: { () }
1473         : vccurly               { () } -- context popped in lexer.
1474         | error                 {% popContext }
1475
1476 -----------------------------------------------------------------------------
1477 -- Miscellaneous (mostly renamings)
1478
1479 modid   :: { Located ModuleName }
1480         : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
1481         | QCONID                { L1 $ let (mod,c) = getQCONID $1 in
1482                                   mkModuleNameFS
1483                                    (mkFastString
1484                                      (unpackFS mod ++ '.':unpackFS c))
1485                                 }
1486
1487 commas :: { Int }
1488         : commas ','                    { $1 + 1 }
1489         | ','                           { 2 }
1490
1491 -----------------------------------------------------------------------------
1492
1493 {
1494 happyError :: P a
1495 happyError = srcParseFail
1496
1497 getVARID        (L _ (ITvarid    x)) = x
1498 getCONID        (L _ (ITconid    x)) = x
1499 getVARSYM       (L _ (ITvarsym   x)) = x
1500 getCONSYM       (L _ (ITconsym   x)) = x
1501 getQVARID       (L _ (ITqvarid   x)) = x
1502 getQCONID       (L _ (ITqconid   x)) = x
1503 getQVARSYM      (L _ (ITqvarsym  x)) = x
1504 getQCONSYM      (L _ (ITqconsym  x)) = x
1505 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
1506 getIPSPLITVARID (L _ (ITsplitipvarid x)) = x
1507 getCHAR         (L _ (ITchar     x)) = x
1508 getSTRING       (L _ (ITstring   x)) = x
1509 getINTEGER      (L _ (ITinteger  x)) = x
1510 getRATIONAL     (L _ (ITrational x)) = x
1511 getPRIMCHAR     (L _ (ITprimchar   x)) = x
1512 getPRIMSTRING   (L _ (ITprimstring x)) = x
1513 getPRIMINTEGER  (L _ (ITprimint    x)) = x
1514 getPRIMFLOAT    (L _ (ITprimfloat  x)) = x
1515 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
1516 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1517
1518 -- Utilities for combining source spans
1519 comb2 :: Located a -> Located b -> SrcSpan
1520 comb2 = combineLocs
1521
1522 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1523 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1524
1525 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1526 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1527                 combineSrcSpans (getLoc c) (getLoc d)
1528
1529 -- strict constructor version:
1530 {-# INLINE sL #-}
1531 sL :: SrcSpan -> a -> Located a
1532 sL span a = span `seq` L span a
1533
1534 -- Make a source location that is just the filename.  This seems slightly
1535 -- neater than trying to construct the span of the text within the file.
1536 fileSrcSpan :: P SrcSpan
1537 fileSrcSpan = do l <- getSrcLoc; return (mkGeneralSrcSpan (srcLocFile l))
1538 }