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