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