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