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