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