compiler/parser/Parser.y.pp

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