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