ghc/compiler/parser/Parser.y.pp

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