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