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                                                         (reverse $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         | INTEGER                       { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
1329         | RATIONAL                      { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
1330         | '(' exp ')'                   { LL (HsPar $2) }
1331         | '(' texp ',' texps ')'        { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1332         | '(#' texps '#)'               { LL $ ExplicitTuple (reverse $2)      Unboxed }
1333         | '[' list ']'                  { LL (unLoc $2) }
1334         | '[:' parr ':]'                { LL (unLoc $2) }
1335         | '(' infixexp qop ')'          { LL $ SectionL $2 $3 }
1336         | '(' qopm infixexp ')'         { LL $ SectionR $2 $3 }
1337         | '_'                           { L1 EWildPat }
1338
1339         -- Template Haskell Extension
1340         | TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice
1341                                         (L1 $ HsVar (mkUnqual varName
1342                                                         (getTH_ID_SPLICE $1)))) } -- $x
1343         | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
1344
1345         | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1346         | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
1347         | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1348         | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
1349         | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }
1350         | '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }
1351         | '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
1352                                            return (LL $ HsBracket (PatBr p)) }
1353         | '[d|' cvtopbody '|]'  { LL $ HsBracket (DecBr (mkGroup $2)) }
1354
1355         -- arrow notation extension
1356         | '(|' aexp2 cmdargs '|)'       { LL $ HsArrForm $2 Nothing (reverse $3) }
1357
1358 cmdargs :: { [LHsCmdTop RdrName] }
1359         : cmdargs acmd                  { $2 : $1 }
1360         | {- empty -}                   { [] }
1361
1362 acmd    :: { LHsCmdTop RdrName }
1363         : aexp2                 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1364
1365 cvtopbody :: { [LHsDecl RdrName] }
1366         :  '{'            cvtopdecls0 '}'               { $2 }
1367         |      vocurly    cvtopdecls0 close             { $2 }
1368
1369 cvtopdecls0 :: { [LHsDecl RdrName] }
1370         : {- empty -}           { [] }
1371         | cvtopdecls            { $1 }
1372
1373 texp :: { LHsExpr RdrName }
1374         : exp                           { $1 }
1375         | qopm infixexp                 { LL $ SectionR $1 $2 }
1376         -- The second production is really here only for bang patterns
1377         -- but
1378
1379 texps :: { [LHsExpr RdrName] }
1380         : texps ',' texp                { $3 : $1 }
1381         | texp                          { [$1] }
1382
1383
1384 -----------------------------------------------------------------------------
1385 -- List expressions
1386
1387 -- The rules below are little bit contorted to keep lexps left-recursive while
1388 -- avoiding another shift/reduce-conflict.
1389
1390 list :: { LHsExpr RdrName }
1391         : texp                  { L1 $ ExplicitList placeHolderType [$1] }
1392         | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1393         | texp '..'             { LL $ ArithSeq noPostTcExpr (From $1) }
1394         | texp ',' exp '..'     { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
1395         | texp '..' exp         { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
1396         | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1397         | texp pquals           { sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
1398
1399 lexps :: { Located [LHsExpr RdrName] }
1400         : lexps ',' texp                { LL ($3 : unLoc $1) }
1401         | texp ',' texp                 { LL [$3,$1] }
1402
1403 -----------------------------------------------------------------------------
1404 -- List Comprehensions
1405
1406 pquals :: { Located [LStmt RdrName] }   -- Either a singleton ParStmt,
1407                                         -- or a reversed list of Stmts
1408         : pquals1                       { case unLoc $1 of
1409                                             [qs] -> L1 qs
1410                                             qss  -> L1 [L1 (ParStmt stmtss)]
1411                                                  where
1412                                                     stmtss = [ (reverse qs, undefined)
1413                                                              | qs <- qss ]
1414                                         }
1415
1416 pquals1 :: { Located [[LStmt RdrName]] }
1417         : pquals1 '|' quals             { LL (unLoc $3 : unLoc $1) }
1418         | '|' quals                     { L (getLoc $2) [unLoc $2] }
1419
1420 quals :: { Located [LStmt RdrName] }
1421         : quals ',' qual                { LL ($3 : unLoc $1) }
1422         | qual                          { L1 [$1] }
1423
1424 -----------------------------------------------------------------------------
1425 -- Parallel array expressions
1426
1427 -- The rules below are little bit contorted; see the list case for details.
1428 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1429 -- Moreover, we allow explicit arrays with no element (represented by the nil
1430 -- constructor in the list case).
1431
1432 parr :: { LHsExpr RdrName }
1433         :                               { noLoc (ExplicitPArr placeHolderType []) }
1434         | exp                           { L1 $ ExplicitPArr placeHolderType [$1] }
1435         | lexps                         { L1 $ ExplicitPArr placeHolderType
1436                                                        (reverse (unLoc $1)) }
1437         | exp '..' exp                  { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
1438         | exp ',' exp '..' exp          { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1439         | exp pquals                    { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
1440
1441 -- We are reusing `lexps' and `pquals' from the list case.
1442
1443 -----------------------------------------------------------------------------
1444 -- Case alternatives
1445
1446 altslist :: { Located [LMatch RdrName] }
1447         : '{'            alts '}'       { LL (reverse (unLoc $2)) }
1448         |     vocurly    alts  close    { L (getLoc $2) (reverse (unLoc $2)) }
1449
1450 alts    :: { Located [LMatch RdrName] }
1451         : alts1                         { L1 (unLoc $1) }
1452         | ';' alts                      { LL (unLoc $2) }
1453
1454 alts1   :: { Located [LMatch RdrName] }
1455         : alts1 ';' alt                 { LL ($3 : unLoc $1) }
1456         | alts1 ';'                     { LL (unLoc $1) }
1457         | alt                           { L1 [$1] }
1458
1459 alt     :: { LMatch RdrName }
1460         : pat opt_sig alt_rhs           { LL (Match [$1] $2 (unLoc $3)) }
1461
1462 alt_rhs :: { Located (GRHSs RdrName) }
1463         : ralt wherebinds               { LL (GRHSs (unLoc $1) (unLoc $2)) }
1464
1465 ralt :: { Located [LGRHS RdrName] }
1466         : '->' exp                      { LL (unguardedRHS $2) }
1467         | gdpats                        { L1 (reverse (unLoc $1)) }
1468
1469 gdpats :: { Located [LGRHS RdrName] }
1470         : gdpats gdpat                  { LL ($2 : unLoc $1) }
1471         | gdpat                         { L1 [$1] }
1472
1473 gdpat   :: { LGRHS RdrName }
1474         : '|' quals '->' exp            { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
1475
1476 -- 'pat' recognises a pattern, including one with a bang at the top
1477 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
1478 -- Bangs inside are parsed as infix operator applications, so that
1479 -- we parse them right when bang-patterns are off
1480 pat     :: { LPat RdrName }
1481 pat     : infixexp              {% checkPattern $1 }
1482         | '!' aexp              {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1483
1484 apat   :: { LPat RdrName }
1485 apat    : aexp                  {% checkPattern $1 }
1486         | '!' aexp              {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1487
1488 apats  :: { [LPat RdrName] }
1489         : apat apats            { $1 : $2 }
1490         | {- empty -}           { [] }
1491
1492 -----------------------------------------------------------------------------
1493 -- Statement sequences
1494
1495 stmtlist :: { Located [LStmt RdrName] }
1496         : '{'           stmts '}'       { LL (unLoc $2) }
1497         |     vocurly   stmts close     { $2 }
1498
1499 --      do { ;; s ; s ; ; s ;; }
1500 -- The last Stmt should be an expression, but that's hard to enforce
1501 -- here, because we need too much lookahead if we see do { e ; }
1502 -- So we use ExprStmts throughout, and switch the last one over
1503 -- in ParseUtils.checkDo instead
1504 stmts :: { Located [LStmt RdrName] }
1505         : stmt stmts_help               { LL ($1 : unLoc $2) }
1506         | ';' stmts                     { LL (unLoc $2) }
1507         | {- empty -}                   { noLoc [] }
1508
1509 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1510         : ';' stmts                     { LL (unLoc $2) }
1511         | {- empty -}                   { noLoc [] }
1512
1513 -- For typing stmts at the GHCi prompt, where
1514 -- the input may consist of just comments.
1515 maybe_stmt :: { Maybe (LStmt RdrName) }
1516         : stmt                          { Just $1 }
1517         | {- nothing -}                 { Nothing }
1518
1519 stmt  :: { LStmt RdrName }
1520         : qual                          { $1 }
1521 -- What is this next production doing?  I have no clue!  SLPJ Dec06
1522         | infixexp '->' exp             {% checkPattern $3 >>= \p ->
1523                                            return (LL $ mkBindStmt p $1) }
1524         | 'rec' stmtlist                { LL $ mkRecStmt (unLoc $2) }
1525
1526 qual  :: { LStmt RdrName }
1527         : pat '<-' exp                  { LL $ mkBindStmt $1 $3 }
1528         | exp                           { L1 $ mkExprStmt $1 }
1529         | 'let' binds                   { LL $ LetStmt (unLoc $2) }
1530
1531 -----------------------------------------------------------------------------
1532 -- Record Field Update/Construction
1533
1534 fbinds  :: { HsRecordBinds RdrName }
1535         : fbinds1                       { $1 }
1536         | {- empty -}                   { [] }
1537
1538 fbinds1 :: { HsRecordBinds RdrName }
1539         : fbinds1 ',' fbind             { $3 : $1 }
1540         | fbind                         { [$1] }
1541
1542 fbind   :: { (Located RdrName, LHsExpr RdrName) }
1543         : qvar '=' exp                  { ($1,$3) }
1544
1545 -----------------------------------------------------------------------------
1546 -- Implicit Parameter Bindings
1547
1548 dbinds  :: { Located [LIPBind RdrName] }
1549         : dbinds ';' dbind              { LL ($3 : unLoc $1) }
1550         | dbinds ';'                    { LL (unLoc $1) }
1551         | dbind                         { L1 [$1] }
1552 --      | {- empty -}                   { [] }
1553
1554 dbind   :: { LIPBind RdrName }
1555 dbind   : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
1556
1557 ipvar   :: { Located (IPName RdrName) }
1558         : IPDUPVARID            { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
1559
1560 -----------------------------------------------------------------------------
1561 -- Deprecations
1562
1563 depreclist :: { Located [RdrName] }
1564 depreclist : deprec_var                 { L1 [unLoc $1] }
1565            | deprec_var ',' depreclist  { LL (unLoc $1 : unLoc $3) }
1566
1567 deprec_var :: { Located RdrName }
1568 deprec_var : var                        { $1 }
1569            | con                        { $1 }
1570
1571 -----------------------------------------
1572 -- Data constructors
1573 qcon    :: { Located RdrName }
1574         : qconid                { $1 }
1575         | '(' qconsym ')'       { LL (unLoc $2) }
1576         | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1577 -- The case of '[:' ':]' is part of the production `parr'
1578
1579 con     :: { Located RdrName }
1580         : conid                 { $1 }
1581         | '(' consym ')'        { LL (unLoc $2) }
1582         | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1583
1584 sysdcon :: { Located DataCon }  -- Wired in data constructors
1585         : '(' ')'               { LL unitDataCon }
1586         | '(' commas ')'        { LL $ tupleCon Boxed $2 }
1587         | '[' ']'               { LL nilDataCon }
1588
1589 conop :: { Located RdrName }
1590         : consym                { $1 }
1591         | '`' conid '`'         { LL (unLoc $2) }
1592
1593 qconop :: { Located RdrName }
1594         : qconsym               { $1 }
1595         | '`' qconid '`'        { LL (unLoc $2) }
1596
1597 -----------------------------------------------------------------------------
1598 -- Type constructors
1599
1600 gtycon  :: { Located RdrName }  -- A "general" qualified tycon
1601         : oqtycon                       { $1 }
1602         | '(' ')'                       { LL $ getRdrName unitTyCon }
1603         | '(' commas ')'                { LL $ getRdrName (tupleTyCon Boxed $2) }
1604         | '(' '->' ')'                  { LL $ getRdrName funTyCon }
1605         | '[' ']'                       { LL $ listTyCon_RDR }
1606         | '[:' ':]'                     { LL $ parrTyCon_RDR }
1607
1608 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon
1609         : qtycon                        { $1 }
1610         | '(' qtyconsym ')'             { LL (unLoc $2) }
1611
1612 qtyconop :: { Located RdrName } -- Qualified or unqualified
1613         : qtyconsym                     { $1 }
1614         | '`' qtycon '`'                { LL (unLoc $2) }
1615
1616 qtycon :: { Located RdrName }   -- Qualified or unqualified
1617         : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
1618         | tycon                         { $1 }
1619
1620 tycon   :: { Located RdrName }  -- Unqualified
1621         : CONID                         { L1 $! mkUnqual tcClsName (getCONID $1) }
1622
1623 qtyconsym :: { Located RdrName }
1624         : QCONSYM                       { L1 $! mkQual tcClsName (getQCONSYM $1) }
1625         | tyconsym                      { $1 }
1626
1627 tyconsym :: { Located RdrName }
1628         : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1629
1630 -----------------------------------------------------------------------------
1631 -- Operators
1632
1633 op      :: { Located RdrName }   -- used in infix decls
1634         : varop                 { $1 }
1635         | conop                 { $1 }
1636
1637 varop   :: { Located RdrName }
1638         : varsym                { $1 }
1639         | '`' varid '`'         { LL (unLoc $2) }
1640
1641 qop     :: { LHsExpr RdrName }   -- used in sections
1642         : qvarop                { L1 $ HsVar (unLoc $1) }
1643         | qconop                { L1 $ HsVar (unLoc $1) }
1644
1645 qopm    :: { LHsExpr RdrName }   -- used in sections
1646         : qvaropm               { L1 $ HsVar (unLoc $1) }
1647         | qconop                { L1 $ HsVar (unLoc $1) }
1648
1649 qvarop :: { Located RdrName }
1650         : qvarsym               { $1 }
1651         | '`' qvarid '`'        { LL (unLoc $2) }
1652
1653 qvaropm :: { Located RdrName }
1654         : qvarsym_no_minus      { $1 }
1655         | '`' qvarid '`'        { LL (unLoc $2) }
1656
1657 -----------------------------------------------------------------------------
1658 -- Type variables
1659
1660 tyvar   :: { Located RdrName }
1661 tyvar   : tyvarid               { $1 }
1662         | '(' tyvarsym ')'      { LL (unLoc $2) }
1663
1664 tyvarop :: { Located RdrName }
1665 tyvarop : '`' tyvarid '`'       { LL (unLoc $2) }
1666         | tyvarsym              { $1 }
1667
1668 tyvarid :: { Located RdrName }
1669         : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
1670         | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
1671         | 'unsafe'              { L1 $! mkUnqual tvName FSLIT("unsafe") }
1672         | 'safe'                { L1 $! mkUnqual tvName FSLIT("safe") }
1673         | 'threadsafe'          { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1674
1675 tyvarsym :: { Located RdrName }
1676 -- Does not include "!", because that is used for strictness marks
1677 --               or ".", because that separates the quantified type vars from the rest
1678 --               or "*", because that's used for kinds
1679 tyvarsym : VARSYM               { L1 $! mkUnqual tvName (getVARSYM $1) }
1680
1681 -----------------------------------------------------------------------------
1682 -- Variables
1683
1684 var     :: { Located RdrName }
1685         : varid                 { $1 }
1686         | '(' varsym ')'        { LL (unLoc $2) }
1687
1688 qvar    :: { Located RdrName }
1689         : qvarid                { $1 }
1690         | '(' varsym ')'        { LL (unLoc $2) }
1691         | '(' qvarsym1 ')'      { LL (unLoc $2) }
1692 -- We've inlined qvarsym here so that the decision about
1693 -- whether it's a qvar or a var can be postponed until
1694 -- *after* we see the close paren.
1695
1696 qvarid :: { Located RdrName }
1697         : varid                 { $1 }
1698         | QVARID                { L1 $ mkQual varName (getQVARID $1) }
1699
1700 varid :: { Located RdrName }
1701         : varid_no_unsafe       { $1 }
1702         | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
1703         | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
1704         | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
1705
1706 varid_no_unsafe :: { Located RdrName }
1707         : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
1708         | special_id            { L1 $! mkUnqual varName (unLoc $1) }
1709         | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
1710         | 'family'              { L1 $! mkUnqual varName FSLIT("family") }
1711
1712 qvarsym :: { Located RdrName }
1713         : varsym                { $1 }
1714         | qvarsym1              { $1 }
1715
1716 qvarsym_no_minus :: { Located RdrName }
1717         : varsym_no_minus       { $1 }
1718         | qvarsym1              { $1 }
1719
1720 qvarsym1 :: { Located RdrName }
1721 qvarsym1 : QVARSYM              { L1 $ mkQual varName (getQVARSYM $1) }
1722
1723 varsym :: { Located RdrName }
1724         : varsym_no_minus       { $1 }
1725         | '-'                   { L1 $ mkUnqual varName FSLIT("-") }
1726
1727 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1728         : VARSYM                { L1 $ mkUnqual varName (getVARSYM $1) }
1729         | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
1730
1731
1732 -- These special_ids are treated as keywords in various places,
1733 -- but as ordinary ids elsewhere.   'special_id' collects all these
1734 -- except 'unsafe', 'forall', and 'family' whose treatment differs
1735 -- depending on context
1736 special_id :: { Located FastString }
1737 special_id
1738         : 'as'                  { L1 FSLIT("as") }
1739         | 'qualified'           { L1 FSLIT("qualified") }
1740         | 'hiding'              { L1 FSLIT("hiding") }
1741         | 'derive'              { L1 FSLIT("derive") }
1742         | 'export'              { L1 FSLIT("export") }
1743         | 'label'               { L1 FSLIT("label")  }
1744         | 'dynamic'             { L1 FSLIT("dynamic") }
1745         | 'stdcall'             { L1 FSLIT("stdcall") }
1746         | 'ccall'               { L1 FSLIT("ccall") }
1747
1748 special_sym :: { Located FastString }
1749 special_sym : '!'       { L1 FSLIT("!") }
1750             | '.'       { L1 FSLIT(".") }
1751             | '*'       { L1 FSLIT("*") }
1752
1753 -----------------------------------------------------------------------------
1754 -- Data constructors
1755
1756 qconid :: { Located RdrName }   -- Qualified or unqualified
1757         : conid                 { $1 }
1758         | QCONID                { L1 $ mkQual dataName (getQCONID $1) }
1759
1760 conid   :: { Located RdrName }
1761         : CONID                 { L1 $ mkUnqual dataName (getCONID $1) }
1762
1763 qconsym :: { Located RdrName }  -- Qualified or unqualified
1764         : consym                { $1 }
1765         | QCONSYM               { L1 $ mkQual dataName (getQCONSYM $1) }
1766
1767 consym :: { Located RdrName }
1768         : CONSYM                { L1 $ mkUnqual dataName (getCONSYM $1) }
1769
1770         -- ':' means only list cons
1771         | ':'                   { L1 $ consDataCon_RDR }
1772
1773
1774 -----------------------------------------------------------------------------
1775 -- Literals
1776
1777 literal :: { Located HsLit }
1778         : CHAR                  { L1 $ HsChar       $ getCHAR $1 }
1779         | STRING                { L1 $ HsString     $ getSTRING $1 }
1780         | PRIMINTEGER           { L1 $ HsIntPrim    $ getPRIMINTEGER $1 }
1781         | PRIMCHAR              { L1 $ HsCharPrim   $ getPRIMCHAR $1 }
1782         | PRIMSTRING            { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1783         | PRIMFLOAT             { L1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
1784         | PRIMDOUBLE            { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1785
1786 -----------------------------------------------------------------------------
1787 -- Layout
1788
1789 close :: { () }
1790         : vccurly               { () } -- context popped in lexer.
1791         | error                 {% popContext }
1792
1793 -----------------------------------------------------------------------------
1794 -- Miscellaneous (mostly renamings)
1795
1796 modid   :: { Located ModuleName }
1797         : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
1798         | QCONID                { L1 $ let (mod,c) = getQCONID $1 in
1799                                   mkModuleNameFS
1800                                    (mkFastString
1801                                      (unpackFS mod ++ '.':unpackFS c))
1802                                 }
1803
1804 commas :: { Int }
1805         : commas ','                    { $1 + 1 }
1806         | ','                           { 2 }
1807
1808 -----------------------------------------------------------------------------
1809 -- Documentation comments
1810
1811 docnext :: { LHsDoc RdrName }
1812   : DOCNEXT {% case parseHaddockParagraphs (tokenise (getDOCNEXT $1)) of {
1813       Left  err -> parseError (getLoc $1) err;
1814       Right doc -> return (L1 doc) } }
1815
1816 docprev :: { LHsDoc RdrName }
1817   : DOCPREV {% case parseHaddockParagraphs (tokenise (getDOCPREV $1)) of {
1818       Left  err -> parseError (getLoc $1) err;
1819       Right doc -> return (L1 doc) } }
1820
1821 docnamed :: { Located (String, (HsDoc RdrName)) }
1822   : DOCNAMED {%
1823       let string = getDOCNAMED $1
1824           (name, rest) = break isSpace string
1825       in case parseHaddockParagraphs (tokenise rest) of {
1826         Left  err -> parseError (getLoc $1) err;
1827         Right doc -> return (L1 (name, doc)) } }
1828
1829 docsection :: { Located (n, HsDoc RdrName) }
1830   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
1831         case parseHaddockString (tokenise doc) of {
1832       Left  err -> parseError (getLoc $1) err;
1833       Right doc -> return (L1 (n, doc)) } }
1834
1835 docoptions :: { String }
1836   : DOCOPTIONS { getDOCOPTIONS $1 }
1837
1838 moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
1839         : DOCNEXT {% let string = getDOCNEXT $1 in
1840                case parseModuleHeader string of {
1841                  Right (str, info) ->
1842                    case parseHaddockParagraphs (tokenise str) of {
1843                      Left err -> parseError (getLoc $1) err;
1844                      Right doc -> return (info, Just doc);
1845                    };
1846                  Left err -> parseError (getLoc $1) err
1847             }  }
1848
1849 maybe_docprev :: { Maybe (LHsDoc RdrName) }
1850         : docprev                       { Just $1 }
1851         | {- empty -}                   { Nothing }
1852
1853 maybe_docnext :: { Maybe (LHsDoc RdrName) }
1854         : docnext                       { Just $1 }
1855         | {- empty -}                   { Nothing }
1856
1857 {
1858 happyError :: P a
1859 happyError = srcParseFail
1860
1861 getVARID        (L _ (ITvarid    x)) = x
1862 getCONID        (L _ (ITconid    x)) = x
1863 getVARSYM       (L _ (ITvarsym   x)) = x
1864 getCONSYM       (L _ (ITconsym   x)) = x
1865 getQVARID       (L _ (ITqvarid   x)) = x
1866 getQCONID       (L _ (ITqconid   x)) = x
1867 getQVARSYM      (L _ (ITqvarsym  x)) = x
1868 getQCONSYM      (L _ (ITqconsym  x)) = x
1869 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
1870 getCHAR         (L _ (ITchar     x)) = x
1871 getSTRING       (L _ (ITstring   x)) = x
1872 getINTEGER      (L _ (ITinteger  x)) = x
1873 getRATIONAL     (L _ (ITrational x)) = x
1874 getPRIMCHAR     (L _ (ITprimchar   x)) = x
1875 getPRIMSTRING   (L _ (ITprimstring x)) = x
1876 getPRIMINTEGER  (L _ (ITprimint    x)) = x
1877 getPRIMFLOAT    (L _ (ITprimfloat  x)) = x
1878 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
1879 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1880 getINLINE       (L _ (ITinline_prag b)) = b
1881 getSPEC_INLINE  (L _ (ITspec_inline_prag b)) = b
1882
1883 getDOCNEXT (L _ (ITdocCommentNext x)) = x
1884 getDOCPREV (L _ (ITdocCommentPrev x)) = x
1885 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
1886 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
1887 getDOCOPTIONS (L _ (ITdocOptions x)) = x
1888
1889 -- Utilities for combining source spans
1890 comb2 :: Located a -> Located b -> SrcSpan
1891 comb2 = combineLocs
1892
1893 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1894 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1895
1896 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1897 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1898                 combineSrcSpans (getLoc c) (getLoc d)
1899
1900 -- strict constructor version:
1901 {-# INLINE sL #-}
1902 sL :: SrcSpan -> a -> Located a
1903 sL span a = span `seq` L span a
1904
1905 -- Make a source location for the file.  We're a bit lazy here and just
1906 -- make a point SrcSpan at line 1, column 0.  Strictly speaking we should
1907 -- try to find the span of the whole file (ToDo).
1908 fileSrcSpan :: P SrcSpan
1909 fileSrcSpan = do
1910   l <- getSrcLoc;
1911   let loc = mkSrcLoc (srcLocFile l) 1 0;
1912   return (mkSrcSpan loc loc)
1913 }