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