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