compiler/parser/Parser.y.pp

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