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