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