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