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 {-# OPTIONS -w #-}
  12 -- The above warning supression flag is a temporary kludge.
  13 -- While working on this module you are encouraged to remove it and fix
  14 -- any warnings in the module. See
  15 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  16 -- for details
  17
  18 module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
  19                 parseHeader ) where
  20
  21 import HsSyn
  22 import RdrHsSyn
  23 import HscTypes         ( IsBootInterface, DeprecTxt )
  24 import Lexer
  25 import RdrName
  26 import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
  27                           unboxedSingletonTyCon, unboxedSingletonDataCon,
  28                           listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
  29 import Type             ( funTyCon )
  30 import ForeignCall      ( Safety(..), CExportSpec(..), CLabelString,
  31                           CCallConv(..), CCallTarget(..), defaultCCallConv
  32                         )
  33 import OccName          ( varName, dataName, tcClsName, tvName )
  34 import DataCon          ( DataCon, dataConName )
  35 import SrcLoc           ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
  36                           SrcSpan, combineLocs, srcLocFile,
  37                           mkSrcLoc, mkSrcSpan )
  38 import Module
  39 import StaticFlags      ( opt_SccProfilingOn, opt_Hpc )
  40 import Type             ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
  41 import BasicTypes       ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
  42                           Activation(..), defaultInlineSpec )
  43 import DynFlags
  44 import OrdList
  45 import HaddockParse
  46 import {-# SOURCE #-} HaddockLex hiding ( Token )
  47 import HaddockUtils
  48
  49 import FastString
  50 import Maybes           ( orElse )
  51 import Outputable
  52
  53 import Control.Monad    ( unless )
  54 import GHC.Exts
  55 import Data.Char
  56 import Control.Monad    ( mplus )
  57 }
  58
  59 {-
  60 -----------------------------------------------------------------------------
  61 24 Februar 2006
  62
  63 Conflicts: 33 shift/reduce
  64            1 reduce/reduce
  65
  66 The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
  67 would think the two should never occur in the same context.
  68
  69   -=chak
  70
  71 -----------------------------------------------------------------------------
  72 31 December 2006
  73
  74 Conflicts: 34 shift/reduce
  75            1 reduce/reduce
  76
  77 The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
  78 would think the two should never occur in the same context.
  79
  80   -=chak
  81
  82 -----------------------------------------------------------------------------
  83 6 December 2006
  84
  85 Conflicts: 32 shift/reduce
  86            1 reduce/reduce
  87
  88 The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
  89 would think the two should never occur in the same context.
  90
  91   -=chak
  92
  93 -----------------------------------------------------------------------------
  94 26 July 2006
  95
  96 Conflicts: 37 shift/reduce
  97            1 reduce/reduce
  98
  99 The reduce/reduce conflict is weird.  It's between tyconsym and consym, and I
 100 would think the two should never occur in the same context.
 101
 102   -=chak
 103
 104 -----------------------------------------------------------------------------
 105 Conflicts: 38 shift/reduce (1.25)
 106
 107 10 for abiguity in 'if x then y else z + 1'             [State 178]
 108         (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
 109         10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
 110
 111 1 for ambiguity in 'if x then y else z :: T'            [State 178]
 112         (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
 113
 114 4 for ambiguity in 'if x then y else z -< e'            [State 178]
 115         (shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
 116         There are four such operators: -<, >-, -<<, >>-
 117
 118
 119 2 for ambiguity in 'case v of { x :: T -> T ... } '     [States 11, 253]
 120         Which of these two is intended?
 121           case v of
 122             (x::T) -> T         -- Rhs is T
 123     or
 124           case v of
 125             (x::T -> T) -> ..   -- Rhs is ...
 126
 127 10 for ambiguity in 'e :: a `b` c'.  Does this mean     [States 11, 253]
 128         (e::a) `b` c, or
 129         (e :: (a `b` c))
 130     As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases
 131     Same duplication between states 11 and 253 as the previous case
 132
 133 1 for ambiguity in 'let ?x ...'                         [State 329]
 134         the parser can't tell whether the ?x is the lhs of a normal binding or
 135         an implicit binding.  Fortunately resolving as shift gives it the only
 136         sensible meaning, namely the lhs of an implicit binding.
 137
 138 1 for ambiguity in '{-# RULES "name" [ ... #-}          [State 382]
 139         we don't know whether the '[' starts the activation or not: it
 140         might be the start of the declaration with the activation being
 141         empty.  --SDM 1/4/2002
 142
 143 1 for ambiguity in '{-# RULES "name" forall = ... #-}'  [State 474]
 144         since 'forall' is a valid variable name, we don't know whether
 145         to treat a forall on the input as the beginning of a quantifier
 146         or the beginning of the rule itself.  Resolving to shift means
 147         it's always treated as a quantifier, hence the above is disallowed.
 148         This saves explicitly defining a grammar for the rule lhs that
 149         doesn't include 'forall'.
 150
 151 1 for ambiguity when the source file starts with "-- | doc". We need another
 152   token of lookahead to determine if a top declaration or the 'module' keyword
 153   follows. Shift parses as if the 'module' keyword follows.
 154
 155 -- ---------------------------------------------------------------------------
 156 -- Adding location info
 157
 158 This is done in a stylised way using the three macros below, L0, L1
 159 and LL.  Each of these macros can be thought of as having type
 160
 161    L0, L1, LL :: a -> Located a
 162
 163 They each add a SrcSpan to their argument.
 164
 165    L0   adds 'noSrcSpan', used for empty productions
 166      -- This doesn't seem to work anymore -=chak
 167
 168    L1   for a production with a single token on the lhs.  Grabs the SrcSpan
 169         from that token.
 170
 171    LL   for a production with >1 token on the lhs.  Makes up a SrcSpan from
 172         the first and last tokens.
 173
 174 These suffice for the majority of cases.  However, we must be
 175 especially careful with empty productions: LL won't work if the first
 176 or last token on the lhs can represent an empty span.  In these cases,
 177 we have to calculate the span using more of the tokens from the lhs, eg.
 178
 179         | 'newtype' tycl_hdr '=' newconstr deriving
 180                 { L (comb3 $1 $4 $5)
 181                     (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
 182
 183 We provide comb3 and comb4 functions which are useful in such cases.
 184
 185 Be careful: there's no checking that you actually got this right, the
 186 only symptom will be that the SrcSpans of your syntax will be
 187 incorrect.
 188
 189 /*
 190  * We must expand these macros *before* running Happy, which is why this file is
 191  * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
 192  */
 193 #define L0   L noSrcSpan
 194 #define L1   sL (getLoc $1)
 195 #define LL   sL (comb2 $1 $>)
 196
 197 -- -----------------------------------------------------------------------------
 198
 199 -}
 200
 201 %token
 202  '_'            { L _ ITunderscore }            -- Haskell keywords
 203  'as'           { L _ ITas }
 204  'case'         { L _ ITcase }
 205  'class'        { L _ ITclass }
 206  'data'         { L _ ITdata }
 207  'default'      { L _ ITdefault }
 208  'deriving'     { L _ ITderiving }
 209  'do'           { L _ ITdo }
 210  'else'         { L _ ITelse }
 211  'hiding'       { L _ IThiding }
 212  'if'           { L _ ITif }
 213  'import'       { L _ ITimport }
 214  'in'           { L _ ITin }
 215  'infix'        { L _ ITinfix }
 216  'infixl'       { L _ ITinfixl }
 217  'infixr'       { L _ ITinfixr }
 218  'instance'     { L _ ITinstance }
 219  'let'          { L _ ITlet }
 220  'module'       { L _ ITmodule }
 221  'newtype'      { L _ ITnewtype }
 222  'of'           { L _ ITof }
 223  'qualified'    { L _ ITqualified }
 224  'then'         { L _ ITthen }
 225  'type'         { L _ ITtype }
 226  'where'        { L _ ITwhere }
 227  '_scc_'        { L _ ITscc }         -- ToDo: remove
 228
 229  'forall'       { L _ ITforall }                -- GHC extension keywords
 230  'foreign'      { L _ ITforeign }
 231  'export'       { L _ ITexport }
 232  'label'        { L _ ITlabel }
 233  'dynamic'      { L _ ITdynamic }
 234  'safe'         { L _ ITsafe }
 235  'threadsafe'   { L _ ITthreadsafe }
 236  'unsafe'       { L _ ITunsafe }
 237  'mdo'          { L _ ITmdo }
 238  'family'       { L _ ITfamily }
 239  'stdcall'      { L _ ITstdcallconv }
 240  'ccall'        { L _ ITccallconv }
 241  'dotnet'       { L _ ITdotnet }
 242  'proc'         { L _ ITproc }          -- for arrow notation extension
 243  'rec'          { L _ ITrec }           -- for arrow notation extension
 244  'group'    { L _ ITgroup }     -- for list transform extension
 245  'by'       { L _ ITby }        -- for list transform extension
 246  'using'    { L _ ITusing }     -- for list transform extension
 247
 248  '{-# INLINE'             { L _ (ITinline_prag _) }
 249  '{-# SPECIALISE'         { L _ ITspec_prag }
 250  '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
 251  '{-# SOURCE'      { L _ ITsource_prag }
 252  '{-# RULES'       { L _ ITrules_prag }
 253  '{-# CORE'        { L _ ITcore_prag }              -- hdaume: annotated core
 254  '{-# SCC'         { L _ ITscc_prag }
 255  '{-# GENERATED'   { L _ ITgenerated_prag }
 256  '{-# DEPRECATED'  { L _ ITdeprecated_prag }
 257  '{-# UNPACK'      { L _ ITunpack_prag }
 258  '#-}'             { L _ ITclose_prag }
 259
 260  '..'           { L _ ITdotdot }                        -- reserved symbols
 261  ':'            { L _ ITcolon }
 262  '::'           { L _ ITdcolon }
 263  '='            { L _ ITequal }
 264  '\\'           { L _ ITlam }
 265  '|'            { L _ ITvbar }
 266  '<-'           { L _ ITlarrow }
 267  '->'           { L _ ITrarrow }
 268  '@'            { L _ ITat }
 269  '~'            { L _ ITtilde }
 270  '=>'           { L _ ITdarrow }
 271  '-'            { L _ ITminus }
 272  '!'            { L _ ITbang }
 273  '*'            { L _ ITstar }
 274  '-<'           { L _ ITlarrowtail }            -- for arrow notation
 275  '>-'           { L _ ITrarrowtail }            -- for arrow notation
 276  '-<<'          { L _ ITLarrowtail }            -- for arrow notation
 277  '>>-'          { L _ ITRarrowtail }            -- for arrow notation
 278  '.'            { L _ ITdot }
 279
 280  '{'            { L _ ITocurly }                        -- special symbols
 281  '}'            { L _ ITccurly }
 282  '{|'           { L _ ITocurlybar }
 283  '|}'           { L _ ITccurlybar }
 284  vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
 285  vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
 286  '['            { L _ ITobrack }
 287  ']'            { L _ ITcbrack }
 288  '[:'           { L _ ITopabrack }
 289  ':]'           { L _ ITcpabrack }
 290  '('            { L _ IToparen }
 291  ')'            { L _ ITcparen }
 292  '(#'           { L _ IToubxparen }
 293  '#)'           { L _ ITcubxparen }
 294  '(|'           { L _ IToparenbar }
 295  '|)'           { L _ ITcparenbar }
 296  ';'            { L _ ITsemi }
 297  ','            { L _ ITcomma }
 298  '`'            { L _ ITbackquote }
 299
 300  VARID          { L _ (ITvarid    _) }          -- identifiers
 301  CONID          { L _ (ITconid    _) }
 302  VARSYM         { L _ (ITvarsym   _) }
 303  CONSYM         { L _ (ITconsym   _) }
 304  QVARID         { L _ (ITqvarid   _) }
 305  QCONID         { L _ (ITqconid   _) }
 306  QVARSYM        { L _ (ITqvarsym  _) }
 307  QCONSYM        { L _ (ITqconsym  _) }
 308
 309  IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
 310
 311  CHAR           { L _ (ITchar     _) }
 312  STRING         { L _ (ITstring   _) }
 313  INTEGER        { L _ (ITinteger  _) }
 314  RATIONAL       { L _ (ITrational _) }
 315
 316  PRIMCHAR       { L _ (ITprimchar   _) }
 317  PRIMSTRING     { L _ (ITprimstring _) }
 318  PRIMINTEGER    { L _ (ITprimint    _) }
 319  PRIMWORD       { L _ (ITprimword  _) }
 320  PRIMFLOAT      { L _ (ITprimfloat  _) }
 321  PRIMDOUBLE     { L _ (ITprimdouble _) }
 322
 323  DOCNEXT        { L _ (ITdocCommentNext _) }
 324  DOCPREV        { L _ (ITdocCommentPrev _) }
 325  DOCNAMED       { L _ (ITdocCommentNamed _) }
 326  DOCSECTION     { L _ (ITdocSection _ _) }
 327
 328 -- Template Haskell
 329 '[|'            { L _ ITopenExpQuote  }
 330 '[p|'           { L _ ITopenPatQuote  }
 331 '[t|'           { L _ ITopenTypQuote  }
 332 '[d|'           { L _ ITopenDecQuote  }
 333 '|]'            { L _ ITcloseQuote    }
 334 TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
 335 '$('            { L _ ITparenEscape   }     -- $( exp )
 336 TH_VAR_QUOTE    { L _ ITvarQuote      }     -- 'x
 337 TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
 338 TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
 339
 340 %monad { P } { >>= } { return }
 341 %lexer { lexer } { L _ ITeof }
 342 %name parseModule module
 343 %name parseStmt   maybe_stmt
 344 %name parseIdentifier  identifier
 345 %name parseType ctype
 346 %partial parseHeader header
 347 %tokentype { (Located Token) }
 348 %%
 349
 350 -----------------------------------------------------------------------------
 351 -- Identifiers; one of the entry points
 352 identifier :: { Located RdrName }
 353         : qvar                          { $1 }
 354         | qcon                          { $1 }
 355         | qvarop                        { $1 }
 356         | qconop                        { $1 }
 357     | '(' '->' ')'      { LL $ getRdrName funTyCon }
 358
 359 -----------------------------------------------------------------------------
 360 -- Module Header
 361
 362 -- The place for module deprecation is really too restrictive, but if it
 363 -- was allowed at its natural place just before 'module', we get an ugly
 364 -- s/r conflict with the second alternative. Another solution would be the
 365 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
 366 -- either, and DEPRECATED is only expected to be used by people who really
 367 -- know what they are doing. :-)
 368
 369 module  :: { Located (HsModule RdrName) }
 370         : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' body
 371                 {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
 372                    return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
 373                           info doc) )}}
 374         | body2
 375                 {% fileSrcSpan >>= \ loc ->
 376                    return (L loc (HsModule Nothing Nothing
 377                           (fst $1) (snd $1) Nothing emptyHaddockModInfo
 378                           Nothing)) }
 379
 380 maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
 381         : moduleheader            { (fst $1, snd $1) }
 382         | {- empty -}             { (emptyHaddockModInfo, Nothing) }
 383
 384 missing_module_keyword :: { () }
 385         : {- empty -}                           {% pushCurrentContext }
 386
 387 maybemoddeprec :: { Maybe DeprecTxt }
 388         : '{-# DEPRECATED' STRING '#-}'         { Just (getSTRING $2) }
 389         |  {- empty -}                          { Nothing }
 390
 391 body    :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
 392         :  '{'            top '}'               { $2 }
 393         |      vocurly    top close             { $2 }
 394
 395 body2   :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
 396         :  '{' top '}'                          { $2 }
 397         |  missing_module_keyword top close     { $2 }
 398
 399 top     :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
 400         : importdecls                           { (reverse $1,[]) }
 401         | importdecls ';' cvtopdecls            { (reverse $1,$3) }
 402         | cvtopdecls                            { ([],$1) }
 403
 404 cvtopdecls :: { [LHsDecl RdrName] }
 405         : topdecls                              { cvTopDecls $1 }
 406
 407 -----------------------------------------------------------------------------
 408 -- Module declaration & imports only
 409
 410 header  :: { Located (HsModule RdrName) }
 411         : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' header_body
 412                 {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
 413                    return (L loc (HsModule (Just $3) $5 $7 [] $4
 414                    info doc))}}
 415         | missing_module_keyword importdecls
 416                 {% fileSrcSpan >>= \ loc ->
 417                    return (L loc (HsModule Nothing Nothing $2 [] Nothing
 418                    emptyHaddockModInfo Nothing)) }
 419
 420 header_body :: { [LImportDecl RdrName] }
 421         :  '{'            importdecls           { $2 }
 422         |      vocurly    importdecls           { $2 }
 423
 424 -----------------------------------------------------------------------------
 425 -- The Export List
 426
 427 maybeexports :: { Maybe [LIE RdrName] }
 428         :  '(' exportlist ')'                   { Just $2 }
 429         |  {- empty -}                          { Nothing }
 430
 431 exportlist :: { [LIE RdrName] }
 432         : expdoclist ',' expdoclist             { $1 ++ $3 }
 433         | exportlist1                           { $1 }
 434
 435 exportlist1 :: { [LIE RdrName] }
 436         : expdoclist export expdoclist ',' exportlist  { $1 ++ ($2 : $3) ++ $5 }
 437         | expdoclist export expdoclist                 { $1 ++ ($2 : $3) }
 438         | expdoclist                                   { $1 }
 439
 440 expdoclist :: { [LIE RdrName] }
 441         : exp_doc expdoclist                           { $1 : $2 }
 442         | {- empty -}                                  { [] }
 443
 444 exp_doc :: { LIE RdrName }
 445         : docsection    { L1 (case (unLoc $1) of (n, doc) -> IEGroup n doc) }
 446         | docnamed      { L1 (IEDocNamed ((fst . unLoc) $1)) }
 447         | docnext       { L1 (IEDoc (unLoc $1)) }
 448
 449    -- No longer allow things like [] and (,,,) to be exported
 450    -- They are built in syntax, always available
 451 export  :: { LIE RdrName }
 452         :  qvar                         { L1 (IEVar (unLoc $1)) }
 453         |  oqtycon                      { L1 (IEThingAbs (unLoc $1)) }
 454         |  oqtycon '(' '..' ')'         { LL (IEThingAll (unLoc $1)) }
 455         |  oqtycon '(' ')'              { LL (IEThingWith (unLoc $1) []) }
 456         |  oqtycon '(' qcnames ')'      { LL (IEThingWith (unLoc $1) (reverse $3)) }
 457         |  'module' modid               { LL (IEModuleContents (unLoc $2)) }
 458
 459 qcnames :: { [RdrName] }
 460         :  qcnames ',' qcname_ext       { unLoc $3 : $1 }
 461         |  qcname_ext                   { [unLoc $1]  }
 462
 463 qcname_ext :: { Located RdrName }       -- Variable or data constructor
 464                                         -- or tagged type constructor
 465         :  qcname                       { $1 }
 466         |  'type' qcon                  { sL (comb2 $1 $2)
 467                                              (setRdrNameSpace (unLoc $2)
 468                                                               tcClsName)  }
 469
 470 -- Cannot pull into qcname_ext, as qcname is also used in expression.
 471 qcname  :: { Located RdrName }  -- Variable or data constructor
 472         :  qvar                         { $1 }
 473         |  qcon                         { $1 }
 474
 475 -----------------------------------------------------------------------------
 476 -- Import Declarations
 477
 478 -- import decls can be *empty*, or even just a string of semicolons
 479 -- whereas topdecls must contain at least one topdecl.
 480
 481 importdecls :: { [LImportDecl RdrName] }
 482         : importdecls ';' importdecl            { $3 : $1 }
 483         | importdecls ';'                       { $1 }
 484         | importdecl                            { [ $1 ] }
 485         | {- empty -}                           { [] }
 486
 487 importdecl :: { LImportDecl RdrName }
 488         : 'import' maybe_src optqualified modid maybeas maybeimpspec
 489                 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
 490
 491 maybe_src :: { IsBootInterface }
 492         : '{-# SOURCE' '#-}'                    { True }
 493         | {- empty -}                           { False }
 494
 495 optqualified :: { Bool }
 496         : 'qualified'                           { True  }
 497         | {- empty -}                           { False }
 498
 499 maybeas :: { Located (Maybe ModuleName) }
 500         : 'as' modid                            { LL (Just (unLoc $2)) }
 501         | {- empty -}                           { noLoc Nothing }
 502
 503 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
 504         : impspec                               { L1 (Just (unLoc $1)) }
 505         | {- empty -}                           { noLoc Nothing }
 506
 507 impspec :: { Located (Bool, [LIE RdrName]) }
 508         :  '(' exportlist ')'                   { LL (False, $2) }
 509         |  'hiding' '(' exportlist ')'          { LL (True,  $3) }
 510
 511 -----------------------------------------------------------------------------
 512 -- Fixity Declarations
 513
 514 prec    :: { Int }
 515         : {- empty -}           { 9 }
 516         | INTEGER               {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
 517
 518 infix   :: { Located FixityDirection }
 519         : 'infix'                               { L1 InfixN  }
 520         | 'infixl'                              { L1 InfixL  }
 521         | 'infixr'                              { L1 InfixR }
 522
 523 ops     :: { Located [Located RdrName] }
 524         : ops ',' op                            { LL ($3 : unLoc $1) }
 525         | op                                    { L1 [$1] }
 526
 527 -----------------------------------------------------------------------------
 528 -- Top-Level Declarations
 529
 530 topdecls :: { OrdList (LHsDecl RdrName) }
 531         : topdecls ';' topdecl                  { $1 `appOL` $3 }
 532         | topdecls ';'                          { $1 }
 533         | topdecl                               { $1 }
 534
 535 topdecl :: { OrdList (LHsDecl RdrName) }
 536         : cl_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
 537         | ty_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
 538         | 'instance' inst_type where_inst
 539             { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
 540               in
 541               unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs ats)))}
 542         | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
 543         | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
 544         | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
 545         | '{-# DEPRECATED' deprecations '#-}'   { $2 }
 546         | '{-# RULES' rules '#-}'               { $2 }
 547         | decl                                  { unLoc $1 }
 548
 549         -- Template Haskell Extension
 550         | '$(' exp ')'                          { unitOL (LL $ SpliceD (SpliceDecl $2)) }
 551         | TH_ID_SPLICE                          { unitOL (LL $ SpliceD (SpliceDecl $
 552                                                         L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
 553                                                   )) }
 554
 555 -- Type classes
 556 --
 557 cl_decl :: { LTyClDecl RdrName }
 558         : 'class' tycl_hdr fds where_cls
 559                 {% do { let { (binds, sigs, ats, docs)           =
 560                                 cvBindsAndSigs (unLoc $4)
 561                             ; (ctxt, tc, tvs, tparms) = unLoc $2}
 562                       ; checkTyVars tparms      -- only type vars allowed
 563                       ; checkKindSigs ats
 564                       ; return $ L (comb4 $1 $2 $3 $4)
 565                                    (mkClassDecl (ctxt, tc, tvs)
 566                                                 (unLoc $3) sigs binds ats docs) } }
 567
 568 -- Type declarations (toplevel)
 569 --
 570 ty_decl :: { LTyClDecl RdrName }
 571            -- ordinary type synonyms
 572         : 'type' type '=' ctype
 573                 -- Note ctype, not sigtype, on the right of '='
 574                 -- We allow an explicit for-all but we don't insert one
 575                 -- in   type Foo a = (b,b)
 576                 -- Instead we just say b is out of scope
 577                 --
 578                 -- Note the use of type for the head; this allows
 579                 -- infix type constructors to be declared
 580                 {% do { (tc, tvs, _) <- checkSynHdr $2 False
 581                       ; return (L (comb2 $1 $4)
 582                                   (TySynonym tc tvs Nothing $4))
 583                       } }
 584
 585            -- type family declarations
 586         | 'type' 'family' type opt_kind_sig
 587                 -- Note the use of type for the head; this allows
 588                 -- infix type constructors to be declared
 589                 --
 590                 {% do { (tc, tvs, _) <- checkSynHdr $3 False
 591                       ; return (L (comb3 $1 $3 $4)
 592                                   (TyFamily TypeFamily tc tvs (unLoc $4)))
 593                       } }
 594
 595            -- type instance declarations
 596         | 'type' 'instance' type '=' ctype
 597                 -- Note the use of type for the head; this allows
 598                 -- infix type constructors and type patterns
 599                 --
 600                 {% do { (tc, tvs, typats) <- checkSynHdr $3 True
 601                       ; return (L (comb2 $1 $5)
 602                                   (TySynonym tc tvs (Just typats) $5))
 603                       } }
 604
 605           -- ordinary data type or newtype declaration
 606         | data_or_newtype tycl_hdr constrs deriving
 607                 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
 608                       ; checkTyVars tparms    -- no type pattern
 609                       ; return $
 610                           L (comb4 $1 $2 $3 $4)
 611                                    -- We need the location on tycl_hdr in case
 612                                    -- constrs and deriving are both empty
 613                             (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
 614                                Nothing (reverse (unLoc $3)) (unLoc $4)) } }
 615
 616           -- ordinary GADT declaration
 617         | data_or_newtype tycl_hdr opt_kind_sig
 618                  'where' gadt_constrlist
 619                  deriving
 620                 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
 621                       ; checkTyVars tparms    -- can have type pats
 622                       ; return $
 623                           L (comb4 $1 $2 $4 $5)
 624                             (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
 625                               (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
 626
 627           -- data/newtype family
 628         | 'data' 'family' tycl_hdr opt_kind_sig
 629                 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
 630                       ; checkTyVars tparms            -- no type pattern
 631                       ; unless (null (unLoc ctxt)) $  -- and no context
 632                           parseError (getLoc ctxt)
 633                             "A family declaration cannot have a context"
 634                       ; return $
 635                           L (comb3 $1 $2 $4)
 636                             (TyFamily DataFamily tc tvs (unLoc $4)) } }
 637
 638           -- data/newtype instance declaration
 639         | data_or_newtype 'instance' tycl_hdr constrs deriving
 640                 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
 641                                              -- can have type pats
 642                       ; return $
 643                           L (comb4 $1 $3 $4 $5)
 644                                    -- We need the location on tycl_hdr in case
 645                                    -- constrs and deriving are both empty
 646                             (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
 647                               Nothing (reverse (unLoc $4)) (unLoc $5)) } }
 648
 649           -- GADT instance declaration
 650         | data_or_newtype 'instance' tycl_hdr opt_kind_sig
 651                  'where' gadt_constrlist
 652                  deriving
 653                 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
 654                                              -- can have type pats
 655                       ; return $
 656                           L (comb4 $1 $3 $6 $7)
 657                             (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
 658                                (unLoc $4) (reverse (unLoc $6)) (unLoc $7)) } }
 659
 660 -- Associate type family declarations
 661 --
 662 -- * They have a different syntax than on the toplevel (no family special
 663 --   identifier).
 664 --
 665 -- * They also need to be separate from instances; otherwise, data family
 666 --   declarations without a kind signature cause parsing conflicts with empty
 667 --   data declarations.
 668 --
 669 at_decl_cls :: { LTyClDecl RdrName }
 670            -- type family declarations
 671         : 'type' type opt_kind_sig
 672                 -- Note the use of type for the head; this allows
 673                 -- infix type constructors to be declared
 674                 --
 675                 {% do { (tc, tvs, _) <- checkSynHdr $2 False
 676                       ; return (L (comb3 $1 $2 $3)
 677                                   (TyFamily TypeFamily tc tvs (unLoc $3)))
 678                       } }
 679
 680            -- default type instance
 681         | 'type' type '=' ctype
 682                 -- Note the use of type for the head; this allows
 683                 -- infix type constructors and type patterns
 684                 --
 685                 {% do { (tc, tvs, typats) <- checkSynHdr $2 True
 686                       ; return (L (comb2 $1 $4)
 687                                   (TySynonym tc tvs (Just typats) $4))
 688                       } }
 689
 690           -- data/newtype family declaration
 691         | 'data' tycl_hdr opt_kind_sig
 692                 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
 693                       ; checkTyVars tparms            -- no type pattern
 694                       ; unless (null (unLoc ctxt)) $  -- and no context
 695                           parseError (getLoc ctxt)
 696                             "A family declaration cannot have a context"
 697                       ; return $
 698                           L (comb3 $1 $2 $3)
 699                             (TyFamily DataFamily tc tvs (unLoc $3))
 700                       } }
 701
 702 -- Associate type instances
 703 --
 704 at_decl_inst :: { LTyClDecl RdrName }
 705            -- type instance declarations
 706         : 'type' type '=' ctype
 707                 -- Note the use of type for the head; this allows
 708                 -- infix type constructors and type patterns
 709                 --
 710                 {% do { (tc, tvs, typats) <- checkSynHdr $2 True
 711                       ; return (L (comb2 $1 $4)
 712                                   (TySynonym tc tvs (Just typats) $4))
 713                       } }
 714
 715         -- data/newtype instance declaration
 716         | data_or_newtype tycl_hdr constrs deriving
 717                 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
 718                                              -- can have type pats
 719                       ; return $
 720                           L (comb4 $1 $2 $3 $4)
 721                                    -- We need the location on tycl_hdr in case
 722                                    -- constrs and deriving are both empty
 723                             (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
 724                               Nothing (reverse (unLoc $3)) (unLoc $4)) } }
 725
 726         -- GADT instance declaration
 727         | data_or_newtype tycl_hdr opt_kind_sig
 728                  'where' gadt_constrlist
 729                  deriving
 730                 {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
 731                                              -- can have type pats
 732                       ; return $
 733                           L (comb4 $1 $2 $5 $6)
 734                             (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
 735                              (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
 736
 737 data_or_newtype :: { Located NewOrData }
 738         : 'data'        { L1 DataType }
 739         | 'newtype'     { L1 NewType }
 740
 741 opt_kind_sig :: { Located (Maybe Kind) }
 742         :                               { noLoc Nothing }
 743         | '::' kind                     { LL (Just (unLoc $2)) }
 744
 745 -- tycl_hdr parses the header of a class or data type decl,
 746 -- which takes the form
 747 --      T a b
 748 --      Eq a => T a
 749 --      (Eq a, Ord b) => T a b
 750 --      T Int [a]                       -- for associated types
 751 -- Rather a lot of inlining here, else we get reduce/reduce errors
 752 tycl_hdr :: { Located (LHsContext RdrName,
 753                        Located RdrName,
 754                        [LHsTyVarBndr RdrName],
 755                        [LHsType RdrName]) }
 756         : context '=>' type             {% checkTyClHdr $1         $3 >>= return.LL }
 757         | type                          {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
 758
 759 -----------------------------------------------------------------------------
 760 -- Stand-alone deriving
 761
 762 -- Glasgow extension: stand-alone deriving declarations
 763 stand_alone_deriving :: { LDerivDecl RdrName }
 764         : 'deriving' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) }
 765
 766 -----------------------------------------------------------------------------
 767 -- Nested declarations
 768
 769 -- Declaration in class bodies
 770 --
 771 decl_cls  :: { Located (OrdList (LHsDecl RdrName)) }
 772 decl_cls  : at_decl_cls                 { LL (unitOL (L1 (TyClD (unLoc $1)))) }
 773           | decl                        { $1 }
 774
 775 decls_cls :: { Located (OrdList (LHsDecl RdrName)) }    -- Reversed
 776           : decls_cls ';' decl_cls      { LL (unLoc $1 `appOL` unLoc $3) }
 777           | decls_cls ';'               { LL (unLoc $1) }
 778           | decl_cls                    { $1 }
 779           | {- empty -}                 { noLoc nilOL }
 780
 781
 782 decllist_cls
 783         :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
 784         : '{'         decls_cls '}'     { LL (unLoc $2) }
 785         |     vocurly decls_cls close   { $2 }
 786
 787 -- Class body
 788 --
 789 where_cls :: { Located (OrdList (LHsDecl RdrName)) }    -- Reversed
 790                                 -- No implicit parameters
 791                                 -- May have type declarations
 792         : 'where' decllist_cls          { LL (unLoc $2) }
 793         | {- empty -}                   { noLoc nilOL }
 794
 795 -- Declarations in instance bodies
 796 --
 797 decl_inst  :: { Located (OrdList (LHsDecl RdrName)) }
 798 decl_inst  : at_decl_inst               { LL (unitOL (L1 (TyClD (unLoc $1)))) }
 799            | decl                       { $1 }
 800
 801 decls_inst :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
 802            : decls_inst ';' decl_inst   { LL (unLoc $1 `appOL` unLoc $3) }
 803            | decls_inst ';'             { LL (unLoc $1) }
 804            | decl_inst                  { $1 }
 805            | {- empty -}                { noLoc nilOL }
 806
 807 decllist_inst
 808         :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
 809         : '{'         decls_inst '}'    { LL (unLoc $2) }
 810         |     vocurly decls_inst close  { $2 }
 811
 812 -- Instance body
 813 --
 814 where_inst :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
 815                                 -- No implicit parameters
 816                                 -- May have type declarations
 817         : 'where' decllist_inst         { LL (unLoc $2) }
 818         | {- empty -}                   { noLoc nilOL }
 819
 820 -- Declarations in binding groups other than classes and instances
 821 --
 822 decls   :: { Located (OrdList (LHsDecl RdrName)) }
 823         : decls ';' decl                { let { this = unLoc $3;
 824                                     rest = unLoc $1;
 825                                     these = rest `appOL` this }
 826                               in rest `seq` this `seq` these `seq`
 827                                     LL these }
 828         | decls ';'                     { LL (unLoc $1) }
 829         | decl                          { $1 }
 830         | {- empty -}                   { noLoc nilOL }
 831
 832 decllist :: { Located (OrdList (LHsDecl RdrName)) }
 833         : '{'            decls '}'      { LL (unLoc $2) }
 834         |     vocurly    decls close    { $2 }
 835
 836 -- Binding groups other than those of class and instance declarations
 837 --
 838 binds   ::  { Located (HsLocalBinds RdrName) }          -- May have implicit parameters
 839                                                 -- No type declarations
 840         : decllist                      { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
 841         | '{'            dbinds '}'     { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
 842         |     vocurly    dbinds close   { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
 843
 844 wherebinds :: { Located (HsLocalBinds RdrName) }        -- May have implicit parameters
 845                                                 -- No type declarations
 846         : 'where' binds                 { LL (unLoc $2) }
 847         | {- empty -}                   { noLoc emptyLocalBinds }
 848
 849
 850 -----------------------------------------------------------------------------
 851 -- Transformation Rules
 852
 853 rules   :: { OrdList (LHsDecl RdrName) }
 854         :  rules ';' rule                       { $1 `snocOL` $3 }
 855         |  rules ';'                            { $1 }
 856         |  rule                                 { unitOL $1 }
 857         |  {- empty -}                          { nilOL }
 858
 859 rule    :: { LHsDecl RdrName }
 860         : STRING activation rule_forall infixexp '=' exp
 861              { LL $ RuleD (HsRule (getSTRING $1)
 862                                   ($2 `orElse` AlwaysActive)
 863                                   $3 $4 placeHolderNames $6 placeHolderNames) }
 864
 865 activation :: { Maybe Activation }
 866         : {- empty -}                           { Nothing }
 867         | explicit_activation                   { Just $1 }
 868
 869 explicit_activation :: { Activation }  -- In brackets
 870         : '[' INTEGER ']'               { ActiveAfter  (fromInteger (getINTEGER $2)) }
 871         | '[' '~' INTEGER ']'           { ActiveBefore (fromInteger (getINTEGER $3)) }
 872
 873 rule_forall :: { [RuleBndr RdrName] }
 874         : 'forall' rule_var_list '.'            { $2 }
 875         | {- empty -}                           { [] }
 876
 877 rule_var_list :: { [RuleBndr RdrName] }
 878         : rule_var                              { [$1] }
 879         | rule_var rule_var_list                { $1 : $2 }
 880
 881 rule_var :: { RuleBndr RdrName }
 882         : varid                                 { RuleBndr $1 }
 883         | '(' varid '::' ctype ')'              { RuleBndrSig $2 $4 }
 884
 885 -----------------------------------------------------------------------------
 886 -- Deprecations (c.f. rules)
 887
 888 deprecations :: { OrdList (LHsDecl RdrName) }
 889         : deprecations ';' deprecation          { $1 `appOL` $3 }
 890         | deprecations ';'                      { $1 }
 891         | deprecation                           { $1 }
 892         | {- empty -}                           { nilOL }
 893
 894 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 895 deprecation :: { OrdList (LHsDecl RdrName) }
 896         : depreclist STRING
 897                 { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
 898                        | n <- unLoc $1 ] }
 899
 900
 901 -----------------------------------------------------------------------------
 902 -- Foreign import and export declarations
 903
 904 fdecl :: { LHsDecl RdrName }
 905 fdecl : 'import' callconv safety fspec
 906                 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
 907       | 'import' callconv        fspec
 908                 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
 909                         return (LL d) } }
 910       | 'export' callconv fspec
 911                 {% mkExport $2 (unLoc $3) >>= return.LL }
 912
 913 callconv :: { CallConv }
 914           : 'stdcall'                   { CCall  StdCallConv }
 915           | 'ccall'                     { CCall  CCallConv   }
 916           | 'dotnet'                    { DNCall             }
 917
 918 safety :: { Safety }
 919         : 'unsafe'                      { PlayRisky }
 920         | 'safe'                        { PlaySafe  False }
 921         | 'threadsafe'                  { PlaySafe  True }
 922
 923 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
 924        : STRING var '::' sigtypedoc     { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
 925        |        var '::' sigtypedoc     { LL (noLoc nilFS, $1, $3) }
 926          -- if the entity string is missing, it defaults to the empty string;
 927          -- the meaning of an empty entity string depends on the calling
 928          -- convention
 929
 930 -----------------------------------------------------------------------------
 931 -- Type signatures
 932
 933 opt_sig :: { Maybe (LHsType RdrName) }
 934         : {- empty -}                   { Nothing }
 935         | '::' sigtype                  { Just $2 }
 936
 937 opt_asig :: { Maybe (LHsType RdrName) }
 938         : {- empty -}                   { Nothing }
 939         | '::' atype                    { Just $2 }
 940
 941 sigtypes1 :: { [LHsType RdrName] }
 942         : sigtype                       { [ $1 ] }
 943         | sigtype ',' sigtypes1         { $1 : $3 }
 944
 945 sigtype :: { LHsType RdrName }
 946         : ctype                         { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
 947         -- Wrap an Implicit forall if there isn't one there already
 948
 949 sigtypedoc :: { LHsType RdrName }
 950         : ctypedoc                      { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
 951         -- Wrap an Implicit forall if there isn't one there already
 952
 953 sig_vars :: { Located [Located RdrName] }
 954          : sig_vars ',' var             { LL ($3 : unLoc $1) }
 955          | var                          { L1 [$1] }
 956
 957 -----------------------------------------------------------------------------
 958 -- Types
 959
 960 infixtype :: { LHsType RdrName }
 961         : btype qtyconop gentype         { LL $ HsOpTy $1 $2 $3 }
 962         | btype tyvarop  gentype         { LL $ HsOpTy $1 $2 $3 }
 963
 964 infixtypedoc :: { LHsType RdrName }
 965         : infixtype                      { $1 }
 966         | infixtype docprev              { LL $ HsDocTy $1 $2 }
 967
 968 gentypedoc :: { LHsType RdrName }
 969         : btype                          { $1 }
 970         | btypedoc                       { $1 }
 971         | infixtypedoc                   { $1 }
 972         | btype '->' ctypedoc            { LL $ HsFunTy $1 $3 }
 973         | btypedoc '->' ctypedoc         { LL $ HsFunTy $1 $3 }
 974
 975 ctypedoc  :: { LHsType RdrName }
 976         : 'forall' tv_bndrs '.' ctypedoc { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
 977         | context '=>' ctypedoc          { LL $ mkImplicitHsForAllTy   $1 $3 }
 978         -- A type of form (context => type) is an *implicit* HsForAllTy
 979         | gentypedoc                     { $1 }
 980
 981 strict_mark :: { Located HsBang }
 982         : '!'                           { L1 HsStrict }
 983         | '{-# UNPACK' '#-}' '!'        { LL HsUnbox }
 984
 985 -- A ctype is a for-all type
 986 ctype   :: { LHsType RdrName }
 987         : 'forall' tv_bndrs '.' ctype   { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
 988         | context '=>' type             { LL $ mkImplicitHsForAllTy   $1 $3 }
 989         -- A type of form (context => type) is an *implicit* HsForAllTy
 990         | type                          { $1 }
 991
 992 -- We parse a context as a btype so that we don't get reduce/reduce
 993 -- errors in ctype.  The basic problem is that
 994 --      (Eq a, Ord a)
 995 -- looks so much like a tuple type.  We can't tell until we find the =>
 996 --
 997 -- We have the t1 ~ t2 form here and in gentype, to permit an individual
 998 -- equational constraint without parenthesis.
 999 context :: { LHsContext RdrName }
1000         : btype '~'      btype          {% checkContext
1001                                              (LL $ HsPredTy (HsEqualP $1 $3)) }
1002         | btype                         {% checkContext $1 }
1003
1004 type :: { LHsType RdrName }
1005         : ipvar '::' gentype            { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
1006         | gentype                       { $1 }
1007
1008 gentype :: { LHsType RdrName }
1009         : btype                         { $1 }
1010         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
1011         | btype tyvarop  gentype        { LL $ HsOpTy $1 $2 $3 }
1012         | btype '->'     ctype          { LL $ HsFunTy $1 $3 }
1013         | btype '~'      btype          { LL $ HsPredTy (HsEqualP $1 $3) }
1014
1015 btype :: { LHsType RdrName }
1016         : btype atype                   { LL $ HsAppTy $1 $2 }
1017         | atype                         { $1 }
1018
1019 btypedoc :: { LHsType RdrName }
1020         : btype atype docprev           { LL $ HsDocTy (L (comb2 $1 $2) (HsAppTy $1 $2)) $3 }
1021         | atype docprev                 { LL $ HsDocTy $1 $2 }
1022
1023 atype :: { LHsType RdrName }
1024         : gtycon                        { L1 (HsTyVar (unLoc $1)) }
1025         | tyvar                         { L1 (HsTyVar (unLoc $1)) }
1026         | strict_mark atype             { LL (HsBangTy (unLoc $1) $2) }
1027         | '(' ctype ',' comma_types1 ')'  { LL $ HsTupleTy Boxed  ($2:$4) }
1028         | '(#' comma_types1 '#)'        { LL $ HsTupleTy Unboxed $2     }
1029         | '[' ctype ']'                 { LL $ HsListTy  $2 }
1030         | '[:' ctype ':]'               { LL $ HsPArrTy  $2 }
1031         | '(' ctype ')'                 { LL $ HsParTy   $2 }
1032         | '(' ctype '::' kind ')'       { LL $ HsKindSig $2 (unLoc $4) }
1033 -- Generics
1034         | INTEGER                       { L1 (HsNumTy (getINTEGER $1)) }
1035
1036 -- An inst_type is what occurs in the head of an instance decl
1037 --      e.g.  (Foo a, Gaz b) => Wibble a b
1038 -- It's kept as a single type, with a MonoDictTy at the right
1039 -- hand corner, for convenience.
1040 inst_type :: { LHsType RdrName }
1041         : sigtype                       {% checkInstType $1 }
1042
1043 inst_types1 :: { [LHsType RdrName] }
1044         : inst_type                     { [$1] }
1045         | inst_type ',' inst_types1     { $1 : $3 }
1046
1047 comma_types0  :: { [LHsType RdrName] }
1048         : comma_types1                  { $1 }
1049         | {- empty -}                   { [] }
1050
1051 comma_types1    :: { [LHsType RdrName] }
1052         : ctype                         { [$1] }
1053         | ctype  ',' comma_types1       { $1 : $3 }
1054
1055 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1056          : tv_bndr tv_bndrs             { $1 : $2 }
1057          | {- empty -}                  { [] }
1058
1059 tv_bndr :: { LHsTyVarBndr RdrName }
1060         : tyvar                         { L1 (UserTyVar (unLoc $1)) }
1061         | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2)
1062                                                           (unLoc $4)) }
1063
1064 fds :: { Located [Located ([RdrName], [RdrName])] }
1065         : {- empty -}                   { noLoc [] }
1066         | '|' fds1                      { LL (reverse (unLoc $2)) }
1067
1068 fds1 :: { Located [Located ([RdrName], [RdrName])] }
1069         : fds1 ',' fd                   { LL ($3 : unLoc $1) }
1070         | fd                            { L1 [$1] }
1071
1072 fd :: { Located ([RdrName], [RdrName]) }
1073         : varids0 '->' varids0          { L (comb3 $1 $2 $3)
1074                                            (reverse (unLoc $1), reverse (unLoc $3)) }
1075
1076 varids0 :: { Located [RdrName] }
1077         : {- empty -}                   { noLoc [] }
1078         | varids0 tyvar                 { LL (unLoc $2 : unLoc $1) }
1079
1080 -----------------------------------------------------------------------------
1081 -- Kinds
1082
1083 kind    :: { Located Kind }
1084         : akind                 { $1 }
1085         | akind '->' kind       { LL (mkArrowKind (unLoc $1) (unLoc $3)) }
1086
1087 akind   :: { Located Kind }
1088         : '*'                   { L1 liftedTypeKind }
1089         | '!'                   { L1 unliftedTypeKind }
1090         | '(' kind ')'          { LL (unLoc $2) }
1091
1092
1093 -----------------------------------------------------------------------------
1094 -- Datatype declarations
1095
1096 gadt_constrlist :: { Located [LConDecl RdrName] }
1097         : '{'            gadt_constrs '}'       { LL (unLoc $2) }
1098         |     vocurly    gadt_constrs close     { $2 }
1099
1100 gadt_constrs :: { Located [LConDecl RdrName] }
1101         : gadt_constrs ';' gadt_constr  { LL ($3 : unLoc $1) }
1102         | gadt_constrs ';'              { $1 }
1103         | gadt_constr                   { L1 [$1] }
1104
1105 -- We allow the following forms:
1106 --      C :: Eq a => a -> T a
1107 --      C :: forall a. Eq a => !a -> T a
1108 --      D { x,y :: a } :: T a
1109 --      forall a. Eq a => D { x,y :: a } :: T a
1110
1111 gadt_constr :: { LConDecl RdrName }
1112         : con '::' sigtype
1113               { LL (mkGadtDecl $1 $3) }
1114         -- Syntax: Maybe merge the record stuff with the single-case above?
1115         --         (to kill the mostly harmless reduce/reduce error)
1116         -- XXX revisit audreyt
1117         | constr_stuff_record '::' sigtype
1118                 { let (con,details) = unLoc $1 in
1119                   LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing) }
1120 {-
1121         | forall context '=>' constr_stuff_record '::' sigtype
1122                 { let (con,details) = unLoc $4 in
1123                   LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6) Nothing ) }
1124         | forall constr_stuff_record '::' sigtype
1125                 { let (con,details) = unLoc $2 in
1126                   LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4) Nothing) }
1127 -}
1128
1129
1130 constrs :: { Located [LConDecl RdrName] }
1131         : {- empty; a GHC extension -}  { noLoc [] }
1132         | maybe_docnext '=' constrs1    { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
1133
1134 constrs1 :: { Located [LConDecl RdrName] }
1135         : constrs1 maybe_docnext '|' maybe_docprev constr { LL (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4) }
1136         | constr                                          { L1 [$1] }
1137
1138 constr :: { LConDecl RdrName }
1139         : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1140                 { let (con,details) = unLoc $5 in
1141                   L (comb4 $2 $3 $4 $5) (ConDecl con Explicit (unLoc $2) $3 details ResTyH98 ($1 `mplus` $6)) }
1142         | maybe_docnext forall constr_stuff maybe_docprev
1143                 { let (con,details) = unLoc $3 in
1144                   L (comb2 $2 $3) (ConDecl con Explicit (unLoc $2) (noLoc []) details ResTyH98 ($1 `mplus` $4)) }
1145
1146 forall :: { Located [LHsTyVarBndr RdrName] }
1147         : 'forall' tv_bndrs '.'         { LL $2 }
1148         | {- empty -}                   { noLoc [] }
1149
1150 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1151 -- We parse the constructor declaration
1152 --      C t1 t2
1153 -- as a btype (treating C as a type constructor) and then convert C to be
1154 -- a data constructor.  Reason: it might continue like this:
1155 --      C t1 t2 %: D Int
1156 -- in which case C really would be a type constructor.  We can't resolve this
1157 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
1158         : btype                         {% mkPrefixCon $1 [] >>= return.LL }
1159         | oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.LL }
1160         | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
1161         | btype conop btype             { LL ($2, InfixCon $1 $3) }
1162
1163 constr_stuff_record :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1164         : oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
1165         | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
1166
1167 fielddecls :: { [([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName))] }
1168         : fielddecl maybe_docnext ',' maybe_docprev fielddecls { addFieldDoc (unLoc $1) $4 : addFieldDocs $5 $2 }
1169         | fielddecl                                            { [unLoc $1] }
1170
1171 fielddecl :: { Located ([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName)) }
1172         : maybe_docnext sig_vars '::' ctype maybe_docprev      { L (comb3 $2 $3 $4) (reverse (unLoc $2), $4, $1 `mplus` $5) }
1173
1174 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1175 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1176 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1177 -- We don't allow a context, but that's sorted out by the type checker.
1178 deriving :: { Located (Maybe [LHsType RdrName]) }
1179         : {- empty -}                           { noLoc Nothing }
1180         | 'deriving' qtycon     {% do { let { L loc tv = $2 }
1181                                       ; p <- checkInstType (L loc (HsTyVar tv))
1182                                       ; return (LL (Just [p])) } }
1183         | 'deriving' '(' ')'                    { LL (Just []) }
1184         | 'deriving' '(' inst_types1 ')'        { LL (Just $3) }
1185              -- Glasgow extension: allow partial
1186              -- applications in derivings
1187
1188 -----------------------------------------------------------------------------
1189 -- Value definitions
1190
1191 {- There's an awkward overlap with a type signature.  Consider
1192         f :: Int -> Int = ...rhs...
1193    Then we can't tell whether it's a type signature or a value
1194    definition with a result signature until we see the '='.
1195    So we have to inline enough to postpone reductions until we know.
1196 -}
1197
1198 {-
1199   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1200   instead of qvar, we get another shift/reduce-conflict. Consider the
1201   following programs:
1202
1203      { (^^) :: Int->Int ; }          Type signature; only var allowed
1204
1205      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
1206                                      qvar allowed (because of instance decls)
1207
1208   We can't tell whether to reduce var to qvar until after we've read the signatures.
1209 -}
1210
1211 docdecl :: { LHsDecl RdrName }
1212         : docdecld { L1 (DocD (unLoc $1)) }
1213
1214 docdecld :: { LDocDecl RdrName }
1215         : docnext                               { L1 (DocCommentNext (unLoc $1)) }
1216         | docprev                               { L1 (DocCommentPrev (unLoc $1)) }
1217         | docnamed                              { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
1218         | docsection                            { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
1219
1220 decl    :: { Located (OrdList (LHsDecl RdrName)) }
1221         : sigdecl                       { $1 }
1222         | '!' aexp rhs                  {% do { pat <- checkPattern $2;
1223                                                 return (LL $ unitOL $ LL $ ValD (
1224                                                         PatBind (LL $ BangPat pat) (unLoc $3)
1225                                                                 placeHolderType placeHolderNames)) } }
1226         | infixexp opt_sig rhs          {% do { r <- checkValDef $1 $2 $3;
1227                                                 let { l = comb2 $1 $> };
1228                                                 return $! (sL l (unitOL $! (sL l $ ValD r))) } }
1229         | docdecl                       { LL $ unitOL $1 }
1230
1231 rhs     :: { Located (GRHSs RdrName) }
1232         : '=' exp wherebinds    { sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
1233         | gdrhs wherebinds      { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) }
1234
1235 gdrhs :: { Located [LGRHS RdrName] }
1236         : gdrhs gdrh            { LL ($2 : unLoc $1) }
1237         | gdrh                  { L1 [$1] }
1238
1239 gdrh :: { LGRHS RdrName }
1240         : '|' guardquals '=' exp        { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
1241
1242 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
1243         : infixexp '::' sigtypedoc
1244                                 {% do s <- checkValSig $1 $3;
1245                                       return (LL $ unitOL (LL $ SigD s)) }
1246                 -- See the above notes for why we need infixexp here
1247         | var ',' sig_vars '::' sigtypedoc
1248                                 { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
1249         | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
1250                                              | n <- unLoc $3 ] }
1251         | '{-# INLINE'   activation qvar '#-}'
1252                                 { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
1253         | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
1254                                 { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
1255                                             | t <- $4] }
1256         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
1257                                 { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
1258                                             | t <- $5] }
1259         | '{-# SPECIALISE' 'instance' inst_type '#-}'
1260                                 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
1261
1262 -----------------------------------------------------------------------------
1263 -- Expressions
1264
1265 exp   :: { LHsExpr RdrName }
1266         : infixexp '::' sigtype         { LL $ ExprWithTySig $1 $3 }
1267         | infixexp '-<' exp             { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
1268         | infixexp '>-' exp             { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
1269         | infixexp '-<<' exp            { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
1270         | infixexp '>>-' exp            { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
1271         | infixexp                      { $1 }
1272
1273 infixexp :: { LHsExpr RdrName }
1274         : exp10                         { $1 }
1275         | infixexp qop exp10            { LL (OpApp $1 $2 (panic "fixity") $3) }
1276
1277 exp10 :: { LHsExpr RdrName }
1278         : '\\' apat apats opt_asig '->' exp
1279                         { LL $ HsLam (mkMatchGroup [LL $ Match ($2:$3) $4
1280                                                                 (unguardedGRHSs $6)
1281                                                             ]) }
1282         | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
1283         | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
1284         | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
1285         | '-' fexp                              { LL $ NegApp $2 noSyntaxExpr }
1286
1287         | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
1288                                            checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
1289                                            return (L loc (mkHsDo DoExpr stmts body)) }
1290         | 'mdo' stmtlist                {% let loc = comb2 $1 $2 in
1291                                            checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
1292                                            return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
1293         | scc_annot exp                         { LL $ if opt_SccProfilingOn
1294                                                         then HsSCC (unLoc $1) $2
1295                                                         else HsPar $2 }
1296         | hpc_annot exp                         { LL $ if opt_Hpc
1297                                                         then HsTickPragma (unLoc $1) $2
1298                                                         else HsPar $2 }
1299
1300         | 'proc' aexp '->' exp
1301                         {% checkPattern $2 >>= \ p ->
1302                            return (LL $ HsProc p (LL $ HsCmdTop $4 []
1303                                                    placeHolderType undefined)) }
1304                                                 -- TODO: is LL right here?
1305
1306         | '{-# CORE' STRING '#-}' exp           { LL $ HsCoreAnn (getSTRING $2) $4 }
1307                                                     -- hdaume: core annotation
1308         | fexp                                  { $1 }
1309
1310 scc_annot :: { Located FastString }
1311         : '_scc_' STRING                        {% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
1312                                    ( do scc <- getSCC $2; return $ LL scc ) }
1313         | '{-# SCC' STRING '#-}'                {% do scc <- getSCC $2; return $ LL scc }
1314
1315 hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
1316         : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
1317                                                 { LL $ (getSTRING $2
1318                                                        ,( fromInteger $ getINTEGER $3
1319                                                         , fromInteger $ getINTEGER $5
1320                                                         )
1321                                                        ,( fromInteger $ getINTEGER $7
1322                                                         , fromInteger $ getINTEGER $9
1323                                                         )
1324                                                        )
1325                                                  }
1326
1327 fexp    :: { LHsExpr RdrName }
1328         : fexp aexp                             { LL $ HsApp $1 $2 }
1329         | aexp                                  { $1 }
1330
1331 aexp    :: { LHsExpr RdrName }
1332         : qvar '@' aexp                 { LL $ EAsPat $1 $3 }
1333         | '~' aexp                      { LL $ ELazyPat $2 }
1334         | aexp1                 { $1 }
1335
1336 aexp1   :: { LHsExpr RdrName }
1337         : aexp1 '{' fbinds '}'  {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) $3
1338                                       ; return (LL r) }}
1339         | aexp2                 { $1 }
1340
1341 -- Here was the syntax for type applications that I was planning
1342 -- but there are difficulties (e.g. what order for type args)
1343 -- so it's not enabled yet.
1344 -- But this case *is* used for the left hand side of a generic definition,
1345 -- which is parsed as an expression before being munged into a pattern
1346         | qcname '{|' gentype '|}'      { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1347                                                      (sL (getLoc $3) (HsType $3)) }
1348
1349 aexp2   :: { LHsExpr RdrName }
1350         : ipvar                         { L1 (HsIPVar $! unLoc $1) }
1351         | qcname                        { L1 (HsVar   $! unLoc $1) }
1352         | literal                       { L1 (HsLit   $! unLoc $1) }
1353 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
1354 -- into HsOverLit when -foverloaded-strings is on.
1355 --      | STRING                        { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRING $1) placeHolderType) }
1356         | INTEGER                       { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGER $1) placeHolderType) }
1357         | RATIONAL                      { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) }
1358         -- N.B.: sections get parsed by these next two productions.
1359         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't correct Haskell98
1360         -- (you'd have to write '((+ 3), (4 -))')
1361         -- but the less cluttered version fell out of having texps.
1362         | '(' texp ')'                  { LL (HsPar $2) }
1363         | '(' texp ',' texps ')'        { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1364         | '(#' texps '#)'               { LL $ ExplicitTuple (reverse $2)      Unboxed }
1365         | '[' list ']'                  { LL (unLoc $2) }
1366         | '[:' parr ':]'                { LL (unLoc $2) }
1367         | '_'                           { L1 EWildPat }
1368
1369         -- Template Haskell Extension
1370         | TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice
1371                                         (L1 $ HsVar (mkUnqual varName
1372                                                         (getTH_ID_SPLICE $1)))) } -- $x
1373         | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
1374
1375         | TH_QUASIQUOTE         { let { loc = getLoc $1
1376                                       ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
1377                                       ; quoterId = mkUnqual varName quoter
1378                                       }
1379                                   in sL loc $ HsQuasiQuoteE (mkHsQuasiQuote quoterId quoteSpan quote) }
1380         | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1381         | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
1382         | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1383         | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
1384         | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }
1385         | '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }
1386         | '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
1387                                         return (LL $ HsBracket (PatBr p)) }
1388         | '[d|' cvtopbody '|]'  {% checkDecBrGroup $2 >>= \g ->
1389                                         return (LL $ HsBracket (DecBr g)) }
1390
1391         -- arrow notation extension
1392         | '(|' aexp2 cmdargs '|)'       { LL $ HsArrForm $2 Nothing (reverse $3) }
1393
1394 cmdargs :: { [LHsCmdTop RdrName] }
1395         : cmdargs acmd                  { $2 : $1 }
1396         | {- empty -}                   { [] }
1397
1398 acmd    :: { LHsCmdTop RdrName }
1399         : aexp2                 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1400
1401 cvtopbody :: { [LHsDecl RdrName] }
1402         :  '{'            cvtopdecls0 '}'               { $2 }
1403         |      vocurly    cvtopdecls0 close             { $2 }
1404
1405 cvtopdecls0 :: { [LHsDecl RdrName] }
1406         : {- empty -}           { [] }
1407         | cvtopdecls            { $1 }
1408
1409 -- tuple expressions: things that can appear unparenthesized as long as they're
1410 -- inside parens or delimitted by commas
1411 texp :: { LHsExpr RdrName }
1412         : exp                           { $1 }
1413         -- Technically, this should only be used for bang patterns,
1414        -- but we can be a little more liberal here and avoid parens
1415        -- inside tuples
1416        | infixexp qop   { LL $ SectionL $1 $2 }
1417         | qopm infixexp       { LL $ SectionR $1 $2 }
1418        -- view patterns get parenthesized above
1419         | exp '->' exp   { LL $ EViewPat $1 $3 }
1420
1421 texps :: { [LHsExpr RdrName] }
1422         : texps ',' texp                { $3 : $1 }
1423         | texp                          { [$1] }
1424
1425
1426 -----------------------------------------------------------------------------
1427 -- List expressions
1428
1429 -- The rules below are little bit contorted to keep lexps left-recursive while
1430 -- avoiding another shift/reduce-conflict.
1431
1432 list :: { LHsExpr RdrName }
1433         : texp                  { L1 $ ExplicitList placeHolderType [$1] }
1434         | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1435         | texp '..'             { LL $ ArithSeq noPostTcExpr (From $1) }
1436         | texp ',' exp '..'     { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
1437         | texp '..' exp         { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
1438         | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1439         | texp '|' flattenedpquals      { sL (comb2 $1 $>) $ mkHsDo ListComp (unLoc $3) $1 }
1440
1441 lexps :: { Located [LHsExpr RdrName] }
1442         : lexps ',' texp                { LL (((:) $! $3) $! unLoc $1) }
1443         | texp ',' texp                 { LL [$3,$1] }
1444
1445 -----------------------------------------------------------------------------
1446 -- List Comprehensions
1447
1448 flattenedpquals :: { Located [LStmt RdrName] }
1449     : pquals   { case (unLoc $1) of
1450                     ParStmt [(qs, _)] -> L1 qs
1451                     -- We just had one thing in our "parallel" list so
1452                     -- we simply return that thing directly
1453
1454                     _ -> L1 [$1]
1455                     -- We actually found some actual parallel lists so
1456                     -- we leave them into as a ParStmt
1457                 }
1458
1459 pquals :: { LStmt RdrName }
1460     : pquals1   { L1 (ParStmt [(qs, undefined) | qs <- (reverse (unLoc $1))]) }
1461
1462 pquals1 :: { Located [[LStmt RdrName]] }
1463     : pquals1 '|' squals    { LL (unLoc $3 : unLoc $1) }
1464     | squals                { L (getLoc $1) [unLoc $1] }
1465
1466 squals :: { Located [LStmt RdrName] }
1467     : squals1               { L (getLoc $1) (reverse (unLoc $1)) }
1468
1469 squals1 :: { Located [LStmt RdrName] }
1470     : transformquals1       { LL (unLoc $1) }
1471
1472 transformquals1 :: { Located [LStmt RdrName] }
1473     : transformquals1 ',' transformqual         { LL $ [LL ((unLoc $3) (unLoc $1))] }
1474     | transformquals1 ',' qual                  { LL ($3 : unLoc $1) }
1475 --  | transformquals1 ',' '{|' pquals '|}'      { LL ($4 : unLoc $1) }
1476     | transformqual                             { LL $ [LL ((unLoc $1) [])] }
1477     | qual                                      { L1 [$1] }
1478 --  | '{|' pquals '|}'                          { L1 [$2] }
1479
1480
1481 -- It is possible to enable bracketing (associating) qualifier lists by uncommenting the lines with {| |}
1482 -- above. Due to a lack of consensus on the syntax, this feature is not being used until we get user
1483 -- demand. Note that the {| |} symbols are reused from -XGenerics and hence if you want to compile
1484 -- a program that makes use of this temporary syntax you must supply that flag to GHC
1485
1486 transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) }
1487     : 'then' exp                { LL $ \leftStmts -> (mkTransformStmt (reverse leftStmts) $2) }
1488     | 'then' exp 'by' exp       { LL $ \leftStmts -> (mkTransformByStmt (reverse leftStmts) $2 $4) }
1489     | 'then' 'group' 'by' exp              { LL $ \leftStmts -> (mkGroupByStmt (reverse leftStmts) $4) }
1490     | 'then' 'group' 'using' exp           { LL $ \leftStmts -> (mkGroupUsingStmt (reverse leftStmts) $4) }
1491     | 'then' 'group' 'by' exp 'using' exp  { LL $ \leftStmts -> (mkGroupByUsingStmt (reverse leftStmts) $4 $6) }
1492
1493 -----------------------------------------------------------------------------
1494 -- Parallel array expressions
1495
1496 -- The rules below are little bit contorted; see the list case for details.
1497 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1498 -- Moreover, we allow explicit arrays with no element (represented by the nil
1499 -- constructor in the list case).
1500
1501 parr :: { LHsExpr RdrName }
1502         :                               { noLoc (ExplicitPArr placeHolderType []) }
1503         | texp                          { L1 $ ExplicitPArr placeHolderType [$1] }
1504         | lexps                         { L1 $ ExplicitPArr placeHolderType
1505                                                        (reverse (unLoc $1)) }
1506         | texp '..' exp                 { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
1507         | texp ',' exp '..' exp         { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1508         | texp '|' flattenedpquals      { LL $ mkHsDo PArrComp (unLoc $3) $1 }
1509
1510 -- We are reusing `lexps' and `flattenedpquals' from the list case.
1511
1512 -----------------------------------------------------------------------------
1513 -- Guards
1514
1515 guardquals :: { Located [LStmt RdrName] }
1516     : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
1517
1518 guardquals1 :: { Located [LStmt RdrName] }
1519     : guardquals1 ',' qual  { LL ($3 : unLoc $1) }
1520     | qual                  { L1 [$1] }
1521
1522 -----------------------------------------------------------------------------
1523 -- Case alternatives
1524
1525 altslist :: { Located [LMatch RdrName] }
1526         : '{'            alts '}'       { LL (reverse (unLoc $2)) }
1527         |     vocurly    alts  close    { L (getLoc $2) (reverse (unLoc $2)) }
1528
1529 alts    :: { Located [LMatch RdrName] }
1530         : alts1                         { L1 (unLoc $1) }
1531         | ';' alts                      { LL (unLoc $2) }
1532
1533 alts1   :: { Located [LMatch RdrName] }
1534         : alts1 ';' alt                 { LL ($3 : unLoc $1) }
1535         | alts1 ';'                     { LL (unLoc $1) }
1536         | alt                           { L1 [$1] }
1537
1538 alt     :: { LMatch RdrName }
1539         : pat opt_sig alt_rhs           { LL (Match [$1] $2 (unLoc $3)) }
1540
1541 alt_rhs :: { Located (GRHSs RdrName) }
1542         : ralt wherebinds               { LL (GRHSs (unLoc $1) (unLoc $2)) }
1543
1544 ralt :: { Located [LGRHS RdrName] }
1545         : '->' exp                      { LL (unguardedRHS $2) }
1546         | gdpats                        { L1 (reverse (unLoc $1)) }
1547
1548 gdpats :: { Located [LGRHS RdrName] }
1549         : gdpats gdpat                  { LL ($2 : unLoc $1) }
1550         | gdpat                         { L1 [$1] }
1551
1552 gdpat   :: { LGRHS RdrName }
1553         : '|' guardquals '->' exp               { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
1554
1555 -- 'pat' recognises a pattern, including one with a bang at the top
1556 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
1557 -- Bangs inside are parsed as infix operator applications, so that
1558 -- we parse them right when bang-patterns are off
1559 pat     :: { LPat RdrName }
1560 pat     :  exp                  {% checkPattern $1 }
1561         | '!' aexp              {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1562
1563 apat   :: { LPat RdrName }
1564 apat    : aexp                  {% checkPattern $1 }
1565         | '!' aexp              {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1566
1567 apats  :: { [LPat RdrName] }
1568         : apat apats            { $1 : $2 }
1569         | {- empty -}           { [] }
1570
1571 -----------------------------------------------------------------------------
1572 -- Statement sequences
1573
1574 stmtlist :: { Located [LStmt RdrName] }
1575         : '{'           stmts '}'       { LL (unLoc $2) }
1576         |     vocurly   stmts close     { $2 }
1577
1578 --      do { ;; s ; s ; ; s ;; }
1579 -- The last Stmt should be an expression, but that's hard to enforce
1580 -- here, because we need too much lookahead if we see do { e ; }
1581 -- So we use ExprStmts throughout, and switch the last one over
1582 -- in ParseUtils.checkDo instead
1583 stmts :: { Located [LStmt RdrName] }
1584         : stmt stmts_help               { LL ($1 : unLoc $2) }
1585         | ';' stmts                     { LL (unLoc $2) }
1586         | {- empty -}                   { noLoc [] }
1587
1588 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1589         : ';' stmts                     { LL (unLoc $2) }
1590         | {- empty -}                   { noLoc [] }
1591
1592 -- For typing stmts at the GHCi prompt, where
1593 -- the input may consist of just comments.
1594 maybe_stmt :: { Maybe (LStmt RdrName) }
1595         : stmt                          { Just $1 }
1596         | {- nothing -}                 { Nothing }
1597
1598 stmt  :: { LStmt RdrName }
1599         : qual                              { $1 }
1600         | 'rec' stmtlist                { LL $ mkRecStmt (unLoc $2) }
1601
1602 qual  :: { LStmt RdrName }
1603     : pat '<-' exp                      { LL $ mkBindStmt $1 $3 }
1604     | exp                                   { L1 $ mkExprStmt $1 }
1605     | 'let' binds                       { LL $ LetStmt (unLoc $2) }
1606
1607 -----------------------------------------------------------------------------
1608 -- Record Field Update/Construction
1609
1610 fbinds  :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
1611         : fbinds1                       { $1 }
1612         | {- empty -}                   { ([], False) }
1613
1614 fbinds1 :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
1615         : fbind ',' fbinds1             { case $3 of (flds, dd) -> ($1 : flds, dd) }
1616         | fbind                         { ([$1], False) }
1617         | '..'                          { ([],   True) }
1618
1619 fbind   :: { HsRecField RdrName (LHsExpr RdrName) }
1620         : qvar '=' exp  { HsRecField $1 $3 False }
1621         | qvar          { HsRecField $1 (L (getLoc $1) (HsVar (unLoc $1))) True }
1622                         -- Here's where we say that plain 'x'
1623                         -- means exactly 'x = x'.  The pun-flag boolean is
1624                         -- there so we can still print it right
1625
1626 -----------------------------------------------------------------------------
1627 -- Implicit Parameter Bindings
1628
1629 dbinds  :: { Located [LIPBind RdrName] }
1630         : dbinds ';' dbind              { let { this = $3; rest = unLoc $1 }
1631                               in rest `seq` this `seq` LL (this : rest) }
1632         | dbinds ';'                    { LL (unLoc $1) }
1633         | dbind                         { let this = $1 in this `seq` L1 [this] }
1634 --      | {- empty -}                   { [] }
1635
1636 dbind   :: { LIPBind RdrName }
1637 dbind   : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
1638
1639 ipvar   :: { Located (IPName RdrName) }
1640         : IPDUPVARID            { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
1641
1642 -----------------------------------------------------------------------------
1643 -- Deprecations
1644
1645 depreclist :: { Located [RdrName] }
1646 depreclist : deprec_var                 { L1 [unLoc $1] }
1647            | deprec_var ',' depreclist  { LL (unLoc $1 : unLoc $3) }
1648
1649 deprec_var :: { Located RdrName }
1650 deprec_var : var                        { $1 }
1651            | con                        { $1 }
1652
1653 -----------------------------------------
1654 -- Data constructors
1655 qcon    :: { Located RdrName }
1656         : qconid                { $1 }
1657         | '(' qconsym ')'       { LL (unLoc $2) }
1658         | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1659 -- The case of '[:' ':]' is part of the production `parr'
1660
1661 con     :: { Located RdrName }
1662         : conid                 { $1 }
1663         | '(' consym ')'        { LL (unLoc $2) }
1664         | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1665
1666 sysdcon :: { Located DataCon }  -- Wired in data constructors
1667         : '(' ')'               { LL unitDataCon }
1668         | '(' commas ')'        { LL $ tupleCon Boxed $2 }
1669         | '(#' '#)'             { LL $ unboxedSingletonDataCon }
1670         | '(#' commas '#)'      { LL $ tupleCon Unboxed $2 }
1671         | '[' ']'               { LL nilDataCon }
1672
1673 conop :: { Located RdrName }
1674         : consym                { $1 }
1675         | '`' conid '`'         { LL (unLoc $2) }
1676
1677 qconop :: { Located RdrName }
1678         : qconsym               { $1 }
1679         | '`' qconid '`'        { LL (unLoc $2) }
1680
1681 -----------------------------------------------------------------------------
1682 -- Type constructors
1683
1684 gtycon  :: { Located RdrName }  -- A "general" qualified tycon
1685         : oqtycon                       { $1 }
1686         | '(' ')'                       { LL $ getRdrName unitTyCon }
1687         | '(' commas ')'                { LL $ getRdrName (tupleTyCon Boxed $2) }
1688         | '(#' '#)'                     { LL $ getRdrName unboxedSingletonTyCon }
1689         | '(#' commas '#)'              { LL $ getRdrName (tupleTyCon Unboxed $2) }
1690         | '(' '->' ')'                  { LL $ getRdrName funTyCon }
1691         | '[' ']'                       { LL $ listTyCon_RDR }
1692         | '[:' ':]'                     { LL $ parrTyCon_RDR }
1693
1694 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon
1695         : qtycon                        { $1 }
1696         | '(' qtyconsym ')'             { LL (unLoc $2) }
1697
1698 qtyconop :: { Located RdrName } -- Qualified or unqualified
1699         : qtyconsym                     { $1 }
1700         | '`' qtycon '`'                { LL (unLoc $2) }
1701
1702 qtycon :: { Located RdrName }   -- Qualified or unqualified
1703         : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
1704         | tycon                         { $1 }
1705
1706 tycon   :: { Located RdrName }  -- Unqualified
1707         : CONID                         { L1 $! mkUnqual tcClsName (getCONID $1) }
1708
1709 qtyconsym :: { Located RdrName }
1710         : QCONSYM                       { L1 $! mkQual tcClsName (getQCONSYM $1) }
1711         | tyconsym                      { $1 }
1712
1713 tyconsym :: { Located RdrName }
1714         : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1715
1716 -----------------------------------------------------------------------------
1717 -- Operators
1718
1719 op      :: { Located RdrName }   -- used in infix decls
1720         : varop                 { $1 }
1721         | conop                 { $1 }
1722
1723 varop   :: { Located RdrName }
1724         : varsym                { $1 }
1725         | '`' varid '`'         { LL (unLoc $2) }
1726
1727 qop     :: { LHsExpr RdrName }   -- used in sections
1728         : qvarop                { L1 $ HsVar (unLoc $1) }
1729         | qconop                { L1 $ HsVar (unLoc $1) }
1730
1731 qopm    :: { LHsExpr RdrName }   -- used in sections
1732         : qvaropm               { L1 $ HsVar (unLoc $1) }
1733         | qconop                { L1 $ HsVar (unLoc $1) }
1734
1735 qvarop :: { Located RdrName }
1736         : qvarsym               { $1 }
1737         | '`' qvarid '`'        { LL (unLoc $2) }
1738
1739 qvaropm :: { Located RdrName }
1740         : qvarsym_no_minus      { $1 }
1741         | '`' qvarid '`'        { LL (unLoc $2) }
1742
1743 -----------------------------------------------------------------------------
1744 -- Type variables
1745
1746 tyvar   :: { Located RdrName }
1747 tyvar   : tyvarid               { $1 }
1748         | '(' tyvarsym ')'      { LL (unLoc $2) }
1749
1750 tyvarop :: { Located RdrName }
1751 tyvarop : '`' tyvarid '`'       { LL (unLoc $2) }
1752         | tyvarsym              { $1 }
1753
1754 tyvarid :: { Located RdrName }
1755         : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
1756         | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
1757         | 'unsafe'              { L1 $! mkUnqual tvName (fsLit "unsafe") }
1758         | 'safe'                { L1 $! mkUnqual tvName (fsLit "safe") }
1759         | 'threadsafe'          { L1 $! mkUnqual tvName (fsLit "threadsafe") }
1760
1761 tyvarsym :: { Located RdrName }
1762 -- Does not include "!", because that is used for strictness marks
1763 --               or ".", because that separates the quantified type vars from the rest
1764 --               or "*", because that's used for kinds
1765 tyvarsym : VARSYM               { L1 $! mkUnqual tvName (getVARSYM $1) }
1766
1767 -----------------------------------------------------------------------------
1768 -- Variables
1769
1770 var     :: { Located RdrName }
1771         : varid                 { $1 }
1772         | '(' varsym ')'        { LL (unLoc $2) }
1773
1774 qvar    :: { Located RdrName }
1775         : qvarid                { $1 }
1776         | '(' varsym ')'        { LL (unLoc $2) }
1777         | '(' qvarsym1 ')'      { LL (unLoc $2) }
1778 -- We've inlined qvarsym here so that the decision about
1779 -- whether it's a qvar or a var can be postponed until
1780 -- *after* we see the close paren.
1781
1782 qvarid :: { Located RdrName }
1783         : varid                 { $1 }
1784         | QVARID                { L1 $ mkQual varName (getQVARID $1) }
1785
1786 varid :: { Located RdrName }
1787         : varid_no_unsafe       { $1 }
1788         | 'unsafe'              { L1 $! mkUnqual varName (fsLit "unsafe") }
1789         | 'safe'                { L1 $! mkUnqual varName (fsLit "safe") }
1790         | 'threadsafe'          { L1 $! mkUnqual varName (fsLit "threadsafe") }
1791
1792 varid_no_unsafe :: { Located RdrName }
1793         : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
1794         | special_id            { L1 $! mkUnqual varName (unLoc $1) }
1795         | 'forall'              { L1 $! mkUnqual varName (fsLit "forall") }
1796         | 'family'              { L1 $! mkUnqual varName (fsLit "family") }
1797
1798 qvarsym :: { Located RdrName }
1799         : varsym                { $1 }
1800         | qvarsym1              { $1 }
1801
1802 qvarsym_no_minus :: { Located RdrName }
1803         : varsym_no_minus       { $1 }
1804         | qvarsym1              { $1 }
1805
1806 qvarsym1 :: { Located RdrName }
1807 qvarsym1 : QVARSYM              { L1 $ mkQual varName (getQVARSYM $1) }
1808
1809 varsym :: { Located RdrName }
1810         : varsym_no_minus       { $1 }
1811         | '-'                   { L1 $ mkUnqual varName (fsLit "-") }
1812
1813 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1814         : VARSYM                { L1 $ mkUnqual varName (getVARSYM $1) }
1815         | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
1816
1817
1818 -- These special_ids are treated as keywords in various places,
1819 -- but as ordinary ids elsewhere.   'special_id' collects all these
1820 -- except 'unsafe', 'forall', and 'family' whose treatment differs
1821 -- depending on context
1822 special_id :: { Located FastString }
1823 special_id
1824         : 'as'                  { L1 (fsLit "as") }
1825         | 'qualified'           { L1 (fsLit "qualified") }
1826         | 'hiding'              { L1 (fsLit "hiding") }
1827         | 'export'              { L1 (fsLit "export") }
1828         | 'label'               { L1 (fsLit "label")  }
1829         | 'dynamic'             { L1 (fsLit "dynamic") }
1830         | 'stdcall'             { L1 (fsLit "stdcall") }
1831         | 'ccall'               { L1 (fsLit "ccall") }
1832
1833 special_sym :: { Located FastString }
1834 special_sym : '!'       { L1 (fsLit "!") }
1835             | '.'       { L1 (fsLit ".") }
1836             | '*'       { L1 (fsLit "*") }
1837
1838 -----------------------------------------------------------------------------
1839 -- Data constructors
1840
1841 qconid :: { Located RdrName }   -- Qualified or unqualified
1842         : conid                 { $1 }
1843         | QCONID                { L1 $ mkQual dataName (getQCONID $1) }
1844
1845 conid   :: { Located RdrName }
1846         : CONID                 { L1 $ mkUnqual dataName (getCONID $1) }
1847
1848 qconsym :: { Located RdrName }  -- Qualified or unqualified
1849         : consym                { $1 }
1850         | QCONSYM               { L1 $ mkQual dataName (getQCONSYM $1) }
1851
1852 consym :: { Located RdrName }
1853         : CONSYM                { L1 $ mkUnqual dataName (getCONSYM $1) }
1854
1855         -- ':' means only list cons
1856         | ':'                   { L1 $ consDataCon_RDR }
1857
1858
1859 -----------------------------------------------------------------------------
1860 -- Literals
1861
1862 literal :: { Located HsLit }
1863         : CHAR                  { L1 $ HsChar       $ getCHAR $1 }
1864         | STRING                { L1 $ HsString     $ getSTRING $1 }
1865         | PRIMINTEGER           { L1 $ HsIntPrim    $ getPRIMINTEGER $1 }
1866         | PRIMWORD              { L1 $ HsWordPrim    $ getPRIMWORD $1 }
1867         | PRIMCHAR              { L1 $ HsCharPrim   $ getPRIMCHAR $1 }
1868         | PRIMSTRING            { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1869         | PRIMFLOAT             { L1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
1870         | PRIMDOUBLE            { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1871
1872 -----------------------------------------------------------------------------
1873 -- Layout
1874
1875 close :: { () }
1876         : vccurly               { () } -- context popped in lexer.
1877         | error                 {% popContext }
1878
1879 -----------------------------------------------------------------------------
1880 -- Miscellaneous (mostly renamings)
1881
1882 modid   :: { Located ModuleName }
1883         : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
1884         | QCONID                { L1 $ let (mod,c) = getQCONID $1 in
1885                                   mkModuleNameFS
1886                                    (mkFastString
1887                                      (unpackFS mod ++ '.':unpackFS c))
1888                                 }
1889
1890 commas :: { Int }
1891         : commas ','                    { $1 + 1 }
1892         | ','                           { 2 }
1893
1894 -----------------------------------------------------------------------------
1895 -- Documentation comments
1896
1897 docnext :: { LHsDoc RdrName }
1898   : DOCNEXT {% case parseHaddockParagraphs (tokenise (getDOCNEXT $1)) of {
1899       MyLeft  err -> parseError (getLoc $1) err;
1900       MyRight doc -> return (L1 doc) } }
1901
1902 docprev :: { LHsDoc RdrName }
1903   : DOCPREV {% case parseHaddockParagraphs (tokenise (getDOCPREV $1)) of {
1904       MyLeft  err -> parseError (getLoc $1) err;
1905       MyRight doc -> return (L1 doc) } }
1906
1907 docnamed :: { Located (String, (HsDoc RdrName)) }
1908   : DOCNAMED {%
1909       let string = getDOCNAMED $1
1910           (name, rest) = break isSpace string
1911       in case parseHaddockParagraphs (tokenise rest) of {
1912         MyLeft  err -> parseError (getLoc $1) err;
1913         MyRight doc -> return (L1 (name, doc)) } }
1914
1915 docsection :: { Located (Int, HsDoc RdrName) }
1916   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
1917         case parseHaddockString (tokenise doc) of {
1918       MyLeft  err -> parseError (getLoc $1) err;
1919       MyRight doc -> return (L1 (n, doc)) } }
1920
1921 moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
1922         : DOCNEXT {% let string = getDOCNEXT $1 in
1923                case parseModuleHeader string of {
1924                  Right (str, info) ->
1925                    case parseHaddockParagraphs (tokenise str) of {
1926                      MyLeft err -> parseError (getLoc $1) err;
1927                      MyRight doc -> return (info, Just doc);
1928                    };
1929                  Left err -> parseError (getLoc $1) err
1930             }  }
1931
1932 maybe_docprev :: { Maybe (LHsDoc RdrName) }
1933         : docprev                       { Just $1 }
1934         | {- empty -}                   { Nothing }
1935
1936 maybe_docnext :: { Maybe (LHsDoc RdrName) }
1937         : docnext                       { Just $1 }
1938         | {- empty -}                   { Nothing }
1939
1940 {
1941 happyError :: P a
1942 happyError = srcParseFail
1943
1944 getVARID        (L _ (ITvarid    x)) = x
1945 getCONID        (L _ (ITconid    x)) = x
1946 getVARSYM       (L _ (ITvarsym   x)) = x
1947 getCONSYM       (L _ (ITconsym   x)) = x
1948 getQVARID       (L _ (ITqvarid   x)) = x
1949 getQCONID       (L _ (ITqconid   x)) = x
1950 getQVARSYM      (L _ (ITqvarsym  x)) = x
1951 getQCONSYM      (L _ (ITqconsym  x)) = x
1952 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
1953 getCHAR         (L _ (ITchar     x)) = x
1954 getSTRING       (L _ (ITstring   x)) = x
1955 getINTEGER      (L _ (ITinteger  x)) = x
1956 getRATIONAL     (L _ (ITrational x)) = x
1957 getPRIMCHAR     (L _ (ITprimchar   x)) = x
1958 getPRIMSTRING   (L _ (ITprimstring x)) = x
1959 getPRIMINTEGER  (L _ (ITprimint    x)) = x
1960 getPRIMWORD     (L _ (ITprimword x)) = x
1961 getPRIMFLOAT    (L _ (ITprimfloat  x)) = x
1962 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
1963 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1964 getINLINE       (L _ (ITinline_prag b)) = b
1965 getSPEC_INLINE  (L _ (ITspec_inline_prag b)) = b
1966
1967 getDOCNEXT (L _ (ITdocCommentNext x)) = x
1968 getDOCPREV (L _ (ITdocCommentPrev x)) = x
1969 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
1970 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
1971
1972 getSCC :: Located Token -> P FastString
1973 getSCC lt = do let s = getSTRING lt
1974                    err = "Spaces are not allowed in SCCs"
1975                -- We probably actually want to be more restrictive than this
1976                if ' ' `elem` unpackFS s
1977                    then failSpanMsgP (getLoc lt) (text err)
1978                    else return s
1979
1980 -- Utilities for combining source spans
1981 comb2 :: Located a -> Located b -> SrcSpan
1982 comb2 a b = a `seq` b `seq` combineLocs a b
1983
1984 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1985 comb3 a b c = a `seq` b `seq` c `seq`
1986     combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1987
1988 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1989 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
1990     (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1991                 combineSrcSpans (getLoc c) (getLoc d))
1992
1993 -- strict constructor version:
1994 {-# INLINE sL #-}
1995 sL :: SrcSpan -> a -> Located a
1996 sL span a = span `seq` a `seq` L span a
1997
1998 -- Make a source location for the file.  We're a bit lazy here and just
1999 -- make a point SrcSpan at line 1, column 0.  Strictly speaking we should
2000 -- try to find the span of the whole file (ToDo).
2001 fileSrcSpan :: P SrcSpan
2002 fileSrcSpan = do
2003   l <- getSrcLoc;
2004   let loc = mkSrcLoc (srcLocFile l) 1 0;
2005   return (mkSrcSpan loc loc)
2006 }