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 sigtypes :: { [LHsType RdrName] }
 727         : sigtype                       { [ $1 ] }
 728         | sigtypes ',' sigtype          { $3 : $1 }
 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 comma_types0  :: { [LHsType RdrName] }
 789         : comma_types1                  { $1 }
 790         | {- empty -}                   { [] }
 791
 792 comma_types1    :: { [LHsType RdrName] }
 793         : type                          { [$1] }
 794         | type  ',' comma_types1        { $1 : $3 }
 795
 796 tv_bndrs :: { [LHsTyVarBndr RdrName] }
 797          : tv_bndr tv_bndrs             { $1 : $2 }
 798          | {- empty -}                  { [] }
 799
 800 tv_bndr :: { LHsTyVarBndr RdrName }
 801         : tyvar                         { L1 (UserTyVar (unLoc $1)) }
 802         | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) $4) }
 803
 804 fds :: { Located [Located ([RdrName], [RdrName])] }
 805         : {- empty -}                   { noLoc [] }
 806         | '|' fds1                      { LL (reverse (unLoc $2)) }
 807
 808 fds1 :: { Located [Located ([RdrName], [RdrName])] }
 809         : fds1 ',' fd                   { LL ($3 : unLoc $1) }
 810         | fd                            { L1 [$1] }
 811
 812 fd :: { Located ([RdrName], [RdrName]) }
 813         : varids0 '->' varids0          { L (comb3 $1 $2 $3)
 814                                            (reverse (unLoc $1), reverse (unLoc $3)) }
 815
 816 varids0 :: { Located [RdrName] }
 817         : {- empty -}                   { noLoc [] }
 818         | varids0 tyvar                 { LL (unLoc $2 : unLoc $1) }
 819
 820 -----------------------------------------------------------------------------
 821 -- Kinds
 822
 823 kind    :: { Kind }
 824         : akind                 { $1 }
 825         | akind '->' kind       { mkArrowKind $1 $3 }
 826
 827 akind   :: { Kind }
 828         : '*'                   { liftedTypeKind }
 829         | '(' kind ')'          { $2 }
 830
 831
 832 -----------------------------------------------------------------------------
 833 -- Datatype declarations
 834
 835 newconstr :: { LConDecl RdrName }
 836         : conid atype   { LL $ ConDecl $1 [] (noLoc [])
 837                                 (PrefixCon [(unbangedType $2)]) }
 838         | conid '{' var '::' ctype '}'
 839                         { LL $ ConDecl $1 [] (noLoc [])
 840                                   (RecCon [($3, (unbangedType $5))]) }
 841
 842 constrs :: { Located [LConDecl RdrName] }
 843         : {- empty; a GHC extension -}  { noLoc [] }
 844         | '=' constrs1                  { LL (unLoc $2) }
 845
 846 constrs1 :: { Located [LConDecl RdrName] }
 847         : constrs1 '|' constr           { LL ($3 : unLoc $1) }
 848         | constr                        { L1 [$1] }
 849
 850 constr :: { LConDecl RdrName }
 851         : forall context '=>' constr_stuff
 852                 { let (con,details) = unLoc $4 in
 853                   LL (ConDecl con (unLoc $1) $2 details) }
 854         | forall constr_stuff
 855                 { let (con,details) = unLoc $2 in
 856                   LL (ConDecl con (unLoc $1) (noLoc []) details) }
 857
 858 forall :: { Located [LHsTyVarBndr RdrName] }
 859         : 'forall' tv_bndrs '.'         { LL $2 }
 860         | {- empty -}                   { noLoc [] }
 861
 862 constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
 863         : btype                         {% mkPrefixCon $1 [] >>= return.LL }
 864         | btype bang_atype satypes      {% do { r <- mkPrefixCon $1 ($2 : unLoc $3);
 865                                                 return (L (comb3 $1 $2 $3) r) } }
 866         | oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.LL }
 867         | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
 868         | sbtype conop sbtype           { LL ($2, InfixCon $1 $3) }
 869
 870 bang_atype :: { LBangType RdrName }
 871         : strict_mark atype             { LL (BangType (unLoc $1) $2) }
 872
 873 satypes :: { Located [LBangType RdrName] }
 874         : atype satypes                 { LL (unbangedType $1 : unLoc $2) }
 875         | bang_atype satypes            { LL ($1 : unLoc $2) }
 876         | {- empty -}                   { noLoc [] }
 877
 878 sbtype :: { LBangType RdrName }
 879         : btype                         { unbangedType $1 }
 880         | strict_mark atype             { LL (BangType (unLoc $1) $2) }
 881
 882 fielddecls :: { [([Located RdrName], LBangType RdrName)] }
 883         : fielddecl ',' fielddecls      { unLoc $1 : $3 }
 884         | fielddecl                     { [unLoc $1] }
 885
 886 fielddecl :: { Located ([Located RdrName], LBangType RdrName) }
 887         : sig_vars '::' stype           { LL (reverse (unLoc $1), $3) }
 888
 889 stype :: { LBangType RdrName }
 890         : ctype                         { unbangedType $1 }
 891         | strict_mark atype             { LL (BangType (unLoc $1) $2) }
 892
 893 strict_mark :: { Located HsBang }
 894         : '!'                           { L1 HsStrict }
 895         | '{-# UNPACK' '#-}' '!'        { LL HsUnbox }
 896
 897 deriving :: { Located (Maybe (LHsContext RdrName)) }
 898         : {- empty -}                   { noLoc Nothing }
 899         | 'deriving' context            { LL (Just $2) }
 900              -- Glasgow extension: allow partial
 901              -- applications in derivings
 902
 903 -----------------------------------------------------------------------------
 904 -- Value definitions
 905
 906 {- There's an awkward overlap with a type signature.  Consider
 907         f :: Int -> Int = ...rhs...
 908    Then we can't tell whether it's a type signature or a value
 909    definition with a result signature until we see the '='.
 910    So we have to inline enough to postpone reductions until we know.
 911 -}
 912
 913 {-
 914   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
 915   instead of qvar, we get another shift/reduce-conflict. Consider the
 916   following programs:
 917
 918      { (^^) :: Int->Int ; }          Type signature; only var allowed
 919
 920      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
 921                                      qvar allowed (because of instance decls)
 922
 923   We can't tell whether to reduce var to qvar until after we've read the signatures.
 924 -}
 925
 926 decl    :: { Located (OrdList (LHsDecl RdrName)) }
 927         : sigdecl                       { $1 }
 928         | infixexp opt_sig rhs          {% do { r <- checkValDef $1 $2 (unLoc $3);
 929                                                 return (LL $ unitOL (LL $ ValD r)) } }
 930
 931 rhs     :: { Located (GRHSs RdrName) }
 932         : '=' exp wherebinds    { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) placeHolderType }
 933         | gdrhs wherebinds      { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) placeHolderType }
 934
 935 gdrhs :: { Located [LGRHS RdrName] }
 936         : gdrhs gdrh            { LL ($2 : unLoc $1) }
 937         | gdrh                  { L1 [$1] }
 938
 939 gdrh :: { LGRHS RdrName }
 940         : '|' quals '=' exp     { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) :
 941                                                         unLoc $2)) }
 942
 943 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
 944         : infixexp '::' sigtype
 945                                 {% do s <- checkValSig $1 $3;
 946                                       return (LL $ unitOL (LL $ SigD s)) }
 947                 -- See the above notes for why we need infixexp here
 948         | var ',' sig_vars '::' sigtype
 949                                 { LL $ toOL [ LL $ SigD (Sig n $5) | n <- $1 : unLoc $3 ] }
 950         | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
 951                                              | n <- unLoc $3 ] }
 952         | '{-# INLINE'   activation qvar '#-}'
 953                                 { LL $ unitOL (LL $ SigD (InlineSig True  $3 $2)) }
 954         | '{-# NOINLINE' inverse_activation qvar '#-}'
 955                                 { LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) }
 956         | '{-# SPECIALISE' qvar '::' sigtypes '#-}'
 957                                 { LL $ toOL [ LL $ SigD (SpecSig $2 t)
 958                                             | t <- $4] }
 959         | '{-# SPECIALISE' 'instance' inst_type '#-}'
 960                                 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
 961
 962 -----------------------------------------------------------------------------
 963 -- Expressions
 964
 965 exp   :: { LHsExpr RdrName }
 966         : infixexp '::' sigtype         { LL $ ExprWithTySig $1 $3 }
 967         | fexp '-<' exp         { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
 968         | fexp '>-' exp         { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
 969         | fexp '-<<' exp        { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
 970         | fexp '>>-' exp        { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
 971         | infixexp                      { $1 }
 972
 973 infixexp :: { LHsExpr RdrName }
 974         : exp10                         { $1 }
 975         | infixexp qop exp10            { LL (OpApp $1 $2 (panic "fixity") $3) }
 976
 977 exp10 :: { LHsExpr RdrName }
 978         : '\\' aexp aexps opt_asig '->' exp
 979                         {% checkPatterns ($2 : reverse $3) >>= \ ps ->
 980                            return (LL $ HsLam (LL $ Match ps $4
 981                                             (GRHSs (unguardedRHS $6) []
 982                                                         placeHolderType))) }
 983         | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
 984         | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
 985         | 'case' exp 'of' altslist              { LL $ HsCase $2 (unLoc $4) }
 986         | '-' fexp                              { LL $ mkHsNegApp $2 }
 987
 988         | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
 989                                            checkDo loc (unLoc $2)  >>= \ stmts ->
 990                                            return (L loc (mkHsDo DoExpr stmts)) }
 991         | 'mdo' stmtlist                {% let loc = comb2 $1 $2 in
 992                                            checkMDo loc (unLoc $2)  >>= \ stmts ->
 993                                            return (L loc (mkHsDo MDoExpr stmts)) }
 994
 995         | scc_annot exp                         { LL $ if opt_SccProfilingOn
 996                                                         then HsSCC (unLoc $1) $2
 997                                                         else HsPar $2 }
 998
 999         | 'proc' aexp '->' exp
1000                         {% checkPattern $2 >>= \ p ->
1001                            return (LL $ HsProc p (LL $ HsCmdTop $4 []
1002                                                    placeHolderType undefined)) }
1003                                                 -- TODO: is LL right here?
1004
1005         | '{-# CORE' STRING '#-}' exp           { LL $ HsCoreAnn (getSTRING $2) $4 }
1006                                                     -- hdaume: core annotation
1007         | fexp                                  { $1 }
1008
1009 scc_annot :: { Located FastString }
1010         : '_scc_' STRING                        { LL $ getSTRING $2 }
1011         | '{-# SCC' STRING '#-}'                { LL $ getSTRING $2 }
1012
1013 fexp    :: { LHsExpr RdrName }
1014         : fexp aexp                             { LL $ HsApp $1 $2 }
1015         | aexp                                  { $1 }
1016
1017 aexps   :: { [LHsExpr RdrName] }
1018         : aexps aexp                            { $2 : $1 }
1019         | {- empty -}                           { [] }
1020
1021 aexp    :: { LHsExpr RdrName }
1022         : qvar '@' aexp                 { LL $ EAsPat $1 $3 }
1023         | '~' aexp                      { LL $ ELazyPat $2 }
1024         | aexp1                         { $1 }
1025
1026 aexp1   :: { LHsExpr RdrName }
1027         : aexp1 '{' fbinds '}'  {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
1028                                                         (reverse $3);
1029                                         return (LL r) }}
1030         | aexp2                 { $1 }
1031
1032 -- Here was the syntax for type applications that I was planning
1033 -- but there are difficulties (e.g. what order for type args)
1034 -- so it's not enabled yet.
1035 -- But this case *is* used for the left hand side of a generic definition,
1036 -- which is parsed as an expression before being munged into a pattern
1037         | qcname '{|' gentype '|}'      { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1038                                                      (sL (getLoc $3) (HsType $3)) }
1039
1040 aexp2   :: { LHsExpr RdrName }
1041         : ipvar                         { L1 (HsIPVar $! unLoc $1) }
1042         | qcname                        { L1 (HsVar   $! unLoc $1) }
1043         | literal                       { L1 (HsLit   $! unLoc $1) }
1044         | INTEGER                       { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
1045         | RATIONAL                      { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
1046         | '(' exp ')'                   { LL (HsPar $2) }
1047         | '(' exp ',' texps ')'         { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1048         | '(#' texps '#)'               { LL $ ExplicitTuple (reverse $2)      Unboxed }
1049         | '[' list ']'                  { LL (unLoc $2) }
1050         | '[:' parr ':]'                { LL (unLoc $2) }
1051         | '(' infixexp qop ')'          { LL $ SectionL $2 $3 }
1052         | '(' qopm infixexp ')'         { LL $ SectionR $2 $3 }
1053         | '_'                           { L1 EWildPat }
1054
1055         -- MetaHaskell Extension
1056         | TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice
1057                                         (L1 $ HsVar (mkUnqual varName
1058                                                         (getTH_ID_SPLICE $1)))) } -- $x
1059         | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
1060
1061         | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1062         | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
1063         | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1064         | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
1065         | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }
1066         | '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }
1067         | '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
1068                                            return (LL $ HsBracket (PatBr p)) }
1069         | '[d|' cvtopbody '|]'  { LL $ HsBracket (DecBr (mkGroup $2)) }
1070
1071         -- arrow notation extension
1072         | '(|' aexp2 cmdargs '|)'       { LL $ HsArrForm $2 Nothing (reverse $3) }
1073
1074 cmdargs :: { [LHsCmdTop RdrName] }
1075         : cmdargs acmd                  { $2 : $1 }
1076         | {- empty -}                   { [] }
1077
1078 acmd    :: { LHsCmdTop RdrName }
1079         : aexp2                 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1080
1081 cvtopbody :: { [LHsDecl RdrName] }
1082         :  '{'            cvtopdecls0 '}'               { $2 }
1083         |      vocurly    cvtopdecls0 close             { $2 }
1084
1085 cvtopdecls0 :: { [LHsDecl RdrName] }
1086         : {- empty -}           { [] }
1087         | cvtopdecls            { $1 }
1088
1089 texps :: { [LHsExpr RdrName] }
1090         : texps ',' exp                 { $3 : $1 }
1091         | exp                           { [$1] }
1092
1093
1094 -----------------------------------------------------------------------------
1095 -- List expressions
1096
1097 -- The rules below are little bit contorted to keep lexps left-recursive while
1098 -- avoiding another shift/reduce-conflict.
1099
1100 list :: { LHsExpr RdrName }
1101         : exp                   { L1 $ ExplicitList placeHolderType [$1] }
1102         | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1103         | exp '..'              { LL $ ArithSeqIn (From $1) }
1104         | exp ',' exp '..'      { LL $ ArithSeqIn (FromThen $1 $3) }
1105         | exp '..' exp          { LL $ ArithSeqIn (FromTo $1 $3) }
1106         | exp ',' exp '..' exp  { LL $ ArithSeqIn (FromThenTo $1 $3 $5) }
1107         | exp pquals            { LL $ mkHsDo ListComp
1108                                         (reverse (L (getLoc $1) (ResultStmt $1) :
1109                                            unLoc $2)) }
1110
1111 lexps :: { Located [LHsExpr RdrName] }
1112         : lexps ',' exp                 { LL ($3 : unLoc $1) }
1113         | exp ',' exp                   { LL [$3,$1] }
1114
1115 -----------------------------------------------------------------------------
1116 -- List Comprehensions
1117
1118 pquals :: { Located [LStmt RdrName] }   -- Either a singleton ParStmt,
1119                                         -- or a reversed list of Stmts
1120         : pquals1                       { case unLoc $1 of
1121                                             [qs] -> L1 qs
1122                                             qss  -> L1 [L1 (ParStmt stmtss)]
1123                                                  where
1124                                                     stmtss = [ (reverse qs, undefined)
1125                                                              | qs <- qss ]
1126                                         }
1127
1128 pquals1 :: { Located [[LStmt RdrName]] }
1129         : pquals1 '|' quals             { LL (unLoc $3 : unLoc $1) }
1130         | '|' quals                     { L (getLoc $2) [unLoc $2] }
1131
1132 quals :: { Located [LStmt RdrName] }
1133         : quals ',' qual                { LL ($3 : unLoc $1) }
1134         | qual                          { L1 [$1] }
1135
1136 -----------------------------------------------------------------------------
1137 -- Parallel array expressions
1138
1139 -- The rules below are little bit contorted; see the list case for details.
1140 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1141 -- Moreover, we allow explicit arrays with no element (represented by the nil
1142 -- constructor in the list case).
1143
1144 parr :: { LHsExpr RdrName }
1145         :                               { noLoc (ExplicitPArr placeHolderType []) }
1146         | exp                           { L1 $ ExplicitPArr placeHolderType [$1] }
1147         | lexps                         { L1 $ ExplicitPArr placeHolderType
1148                                                        (reverse (unLoc $1)) }
1149         | exp '..' exp                  { LL $ PArrSeqIn (FromTo $1 $3) }
1150         | exp ',' exp '..' exp          { LL $ PArrSeqIn (FromThenTo $1 $3 $5) }
1151         | exp pquals                    { LL $ mkHsDo PArrComp
1152                                             (reverse (L (getLoc $1) (ResultStmt $1) :
1153                                                  unLoc $2))
1154                                         }
1155
1156 -- We are reusing `lexps' and `pquals' from the list case.
1157
1158 -----------------------------------------------------------------------------
1159 -- Case alternatives
1160
1161 altslist :: { Located [LMatch RdrName] }
1162         : '{'            alts '}'       { LL (reverse (unLoc $2)) }
1163         |     vocurly    alts  close    { L (getLoc $2) (reverse (unLoc $2)) }
1164
1165 alts    :: { Located [LMatch RdrName] }
1166         : alts1                         { L1 (unLoc $1) }
1167         | ';' alts                      { LL (unLoc $2) }
1168
1169 alts1   :: { Located [LMatch RdrName] }
1170         : alts1 ';' alt                 { LL ($3 : unLoc $1) }
1171         | alts1 ';'                     { LL (unLoc $1) }
1172         | alt                           { L1 [$1] }
1173
1174 alt     :: { LMatch RdrName }
1175         : infixexp opt_sig alt_rhs      {%  checkPattern $1 >>= \p ->
1176                                             return (LL (Match [p] $2 (unLoc $3))) }
1177
1178 alt_rhs :: { Located (GRHSs RdrName) }
1179         : ralt wherebinds               { LL (GRHSs (unLoc $1) (unLoc $2)
1180                                                  placeHolderType) }
1181
1182 ralt :: { Located [LGRHS RdrName] }
1183         : '->' exp                      { LL (unguardedRHS $2) }
1184         | gdpats                        { L1 (reverse (unLoc $1)) }
1185
1186 gdpats :: { Located [LGRHS RdrName] }
1187         : gdpats gdpat                  { LL ($2 : unLoc $1) }
1188         | gdpat                         { L1 [$1] }
1189
1190 gdpat   :: { LGRHS RdrName }
1191         : '|' quals '->' exp            { let r = L (getLoc $4) (ResultStmt $4)
1192                                           in LL $ GRHS (reverse (r : unLoc $2)) }
1193
1194 -----------------------------------------------------------------------------
1195 -- Statement sequences
1196
1197 stmtlist :: { Located [LStmt RdrName] }
1198         : '{'           stmts '}'       { LL (unLoc $2) }
1199         |     vocurly   stmts close     { $2 }
1200
1201 --      do { ;; s ; s ; ; s ;; }
1202 -- The last Stmt should be a ResultStmt, but that's hard to enforce
1203 -- here, because we need too much lookahead if we see do { e ; }
1204 -- So we use ExprStmts throughout, and switch the last one over
1205 -- in ParseUtils.checkDo instead
1206 stmts :: { Located [LStmt RdrName] }
1207         : stmt stmts_help               { LL ($1 : unLoc $2) }
1208         | ';' stmts                     { LL (unLoc $2) }
1209         | {- empty -}                   { noLoc [] }
1210
1211 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1212         : ';' stmts                     { LL (unLoc $2) }
1213         | {- empty -}                   { noLoc [] }
1214
1215 -- For typing stmts at the GHCi prompt, where
1216 -- the input may consist of just comments.
1217 maybe_stmt :: { Maybe (LStmt RdrName) }
1218         : stmt                          { Just $1 }
1219         | {- nothing -}                 { Nothing }
1220
1221 stmt  :: { LStmt RdrName }
1222         : qual                          { $1 }
1223         | infixexp '->' exp             {% checkPattern $3 >>= \p ->
1224                                            return (LL $ BindStmt p $1) }
1225         | 'rec' stmtlist                { LL $ RecStmt (unLoc $2) undefined undefined undefined }
1226
1227 qual  :: { LStmt RdrName }
1228         : infixexp '<-' exp             {% checkPattern $1 >>= \p ->
1229                                            return (LL $ BindStmt p $3) }
1230         | exp                           { L1 $ ExprStmt $1 placeHolderType }
1231         | 'let' binds                   { LL $ LetStmt (unLoc $2) }
1232
1233 -----------------------------------------------------------------------------
1234 -- Record Field Update/Construction
1235
1236 fbinds  :: { HsRecordBinds RdrName }
1237         : fbinds1                       { $1 }
1238         | {- empty -}                   { [] }
1239
1240 fbinds1 :: { HsRecordBinds RdrName }
1241         : fbinds1 ',' fbind             { $3 : $1 }
1242         | fbind                         { [$1] }
1243
1244 fbind   :: { (Located RdrName, LHsExpr RdrName) }
1245         : qvar '=' exp                  { ($1,$3) }
1246
1247 -----------------------------------------------------------------------------
1248 -- Implicit Parameter Bindings
1249
1250 dbinds  :: { Located [LIPBind RdrName] }
1251         : dbinds ';' dbind              { LL ($3 : unLoc $1) }
1252         | dbinds ';'                    { LL (unLoc $1) }
1253         | dbind                         { L1 [$1] }
1254 --      | {- empty -}                   { [] }
1255
1256 dbind   :: { LIPBind RdrName }
1257 dbind   : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
1258
1259 -----------------------------------------------------------------------------
1260 -- Variables, Constructors and Operators.
1261
1262 identifier :: { Located RdrName }
1263         : qvar                          { $1 }
1264         | gcon                          { $1 }
1265         | qvarop                        { $1 }
1266         | qconop                        { $1 }
1267
1268 depreclist :: { Located [RdrName] }
1269 depreclist : deprec_var                 { L1 [unLoc $1] }
1270            | deprec_var ',' depreclist  { LL (unLoc $1 : unLoc $3) }
1271
1272 deprec_var :: { Located RdrName }
1273 deprec_var : var                        { $1 }
1274            | tycon                      { $1 }
1275
1276 gcon    :: { Located RdrName }  -- Data constructor namespace
1277         : sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1278         | qcon                  { $1 }
1279 -- the case of '[:' ':]' is part of the production `parr'
1280
1281 sysdcon :: { Located DataCon }  -- Wired in data constructors
1282         : '(' ')'               { LL unitDataCon }
1283         | '(' commas ')'        { LL $ tupleCon Boxed $2 }
1284         | '[' ']'               { LL nilDataCon }
1285
1286 var     :: { Located RdrName }
1287         : varid                 { $1 }
1288         | '(' varsym ')'        { LL (unLoc $2) }
1289
1290 qvar    :: { Located RdrName }
1291         : qvarid                { $1 }
1292         | '(' varsym ')'        { LL (unLoc $2) }
1293         | '(' qvarsym1 ')'      { LL (unLoc $2) }
1294 -- We've inlined qvarsym here so that the decision about
1295 -- whether it's a qvar or a var can be postponed until
1296 -- *after* we see the close paren.
1297
1298 ipvar   :: { Located (IPName RdrName) }
1299         : IPDUPVARID            { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
1300         | IPSPLITVARID          { L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
1301
1302 qcon    :: { Located RdrName }
1303         : qconid                { $1 }
1304         | '(' qconsym ')'       { LL (unLoc $2) }
1305
1306 varop   :: { Located RdrName }
1307         : varsym                { $1 }
1308         | '`' varid '`'         { LL (unLoc $2) }
1309
1310 qvarop :: { Located RdrName }
1311         : qvarsym               { $1 }
1312         | '`' qvarid '`'        { LL (unLoc $2) }
1313
1314 qvaropm :: { Located RdrName }
1315         : qvarsym_no_minus      { $1 }
1316         | '`' qvarid '`'        { LL (unLoc $2) }
1317
1318 conop :: { Located RdrName }
1319         : consym                { $1 }
1320         | '`' conid '`'         { LL (unLoc $2) }
1321
1322 qconop :: { Located RdrName }
1323         : qconsym               { $1 }
1324         | '`' qconid '`'        { LL (unLoc $2) }
1325
1326 -----------------------------------------------------------------------------
1327 -- Type constructors
1328
1329 gtycon  :: { Located RdrName }  -- A "general" qualified tycon
1330         : oqtycon                       { $1 }
1331         | '(' ')'                       { LL $ getRdrName unitTyCon }
1332         | '(' commas ')'                { LL $ getRdrName (tupleTyCon Boxed $2) }
1333         | '(' '->' ')'                  { LL $ getRdrName funTyCon }
1334         | '[' ']'                       { LL $ listTyCon_RDR }
1335         | '[:' ':]'                     { LL $ parrTyCon_RDR }
1336
1337 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon
1338         : qtycon                        { $1 }
1339         | '(' qtyconsym ')'             { LL (unLoc $2) }
1340
1341 qtyconop :: { Located RdrName } -- Qualified or unqualified
1342         : qtyconsym                     { $1 }
1343         | '`' qtycon '`'                { LL (unLoc $2) }
1344
1345 tyconop :: { Located RdrName }  -- Unqualified
1346         : tyconsym                      { $1 }
1347         | '`' tycon '`'                 { LL (unLoc $2) }
1348
1349 qtycon :: { Located RdrName }   -- Qualified or unqualified
1350         : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
1351         | tycon                         { $1 }
1352
1353 tycon   :: { Located RdrName }  -- Unqualified
1354         : CONID                         { L1 $! mkUnqual tcClsName (getCONID $1) }
1355
1356 qtyconsym :: { Located RdrName }
1357         : QCONSYM                       { L1 $! mkQual tcClsName (getQCONSYM $1) }
1358         | tyconsym                      { $1 }
1359
1360 tyconsym :: { Located RdrName }
1361         : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1362
1363 -----------------------------------------------------------------------------
1364 -- Any operator
1365
1366 op      :: { Located RdrName }   -- used in infix decls
1367         : varop                 { $1 }
1368         | conop                 { $1 }
1369
1370 qop     :: { LHsExpr RdrName }   -- used in sections
1371         : qvarop                { L1 $ HsVar (unLoc $1) }
1372         | qconop                { L1 $ HsVar (unLoc $1) }
1373
1374 qopm    :: { LHsExpr RdrName }   -- used in sections
1375         : qvaropm               { L1 $ HsVar (unLoc $1) }
1376         | qconop                { L1 $ HsVar (unLoc $1) }
1377
1378 -----------------------------------------------------------------------------
1379 -- VarIds
1380
1381 qvarid :: { Located RdrName }
1382         : varid                 { $1 }
1383         | QVARID                { L1 $ mkQual varName (getQVARID $1) }
1384
1385 varid :: { Located RdrName }
1386         : varid_no_unsafe       { $1 }
1387         | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
1388         | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
1389         | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
1390
1391 varid_no_unsafe :: { Located RdrName }
1392         : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
1393         | special_id            { L1 $! mkUnqual varName (unLoc $1) }
1394         | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
1395
1396 tyvar   :: { Located RdrName }
1397         : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
1398         | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
1399         | 'unsafe'              { L1 $! mkUnqual tvName FSLIT("unsafe") }
1400         | 'safe'                { L1 $! mkUnqual tvName FSLIT("safe") }
1401         | 'threadsafe'          { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1402
1403 -- These special_ids are treated as keywords in various places,
1404 -- but as ordinary ids elsewhere.   'special_id' collects all these
1405 -- except 'unsafe' and 'forall' whose treatment differs depending on context
1406 special_id :: { Located UserFS }
1407 special_id
1408         : 'as'                  { L1 FSLIT("as") }
1409         | 'qualified'           { L1 FSLIT("qualified") }
1410         | 'hiding'              { L1 FSLIT("hiding") }
1411         | 'export'              { L1 FSLIT("export") }
1412         | 'label'               { L1 FSLIT("label")  }
1413         | 'dynamic'             { L1 FSLIT("dynamic") }
1414         | 'stdcall'             { L1 FSLIT("stdcall") }
1415         | 'ccall'               { L1 FSLIT("ccall") }
1416
1417 -----------------------------------------------------------------------------
1418 -- Variables
1419
1420 qvarsym :: { Located RdrName }
1421         : varsym                { $1 }
1422         | qvarsym1              { $1 }
1423
1424 qvarsym_no_minus :: { Located RdrName }
1425         : varsym_no_minus       { $1 }
1426         | qvarsym1              { $1 }
1427
1428 qvarsym1 :: { Located RdrName }
1429 qvarsym1 : QVARSYM              { L1 $ mkQual varName (getQVARSYM $1) }
1430
1431 varsym :: { Located RdrName }
1432         : varsym_no_minus       { $1 }
1433         | '-'                   { L1 $ mkUnqual varName FSLIT("-") }
1434
1435 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1436         : VARSYM                { L1 $ mkUnqual varName (getVARSYM $1) }
1437         | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
1438
1439
1440 -- See comments with special_id
1441 special_sym :: { Located UserFS }
1442 special_sym : '!'       { L1 FSLIT("!") }
1443             | '.'       { L1 FSLIT(".") }
1444             | '*'       { L1 FSLIT("*") }
1445
1446 -----------------------------------------------------------------------------
1447 -- Data constructors
1448
1449 qconid :: { Located RdrName }   -- Qualified or unqualifiedb
1450         : conid                 { $1 }
1451         | QCONID                { L1 $ mkQual dataName (getQCONID $1) }
1452
1453 conid   :: { Located RdrName }
1454         : CONID                 { L1 $ mkUnqual dataName (getCONID $1) }
1455
1456 qconsym :: { Located RdrName }  -- Qualified or unqualified
1457         : consym                { $1 }
1458         | QCONSYM               { L1 $ mkQual dataName (getQCONSYM $1) }
1459
1460 consym :: { Located RdrName }
1461         : CONSYM                { L1 $ mkUnqual dataName (getCONSYM $1) }
1462
1463         -- ':' means only list cons
1464         | ':'                   { L1 $ consDataCon_RDR }
1465
1466
1467 -----------------------------------------------------------------------------
1468 -- Literals
1469
1470 literal :: { Located HsLit }
1471         : CHAR                  { L1 $ HsChar       $ getCHAR $1 }
1472         | STRING                { L1 $ HsString     $ getSTRING $1 }
1473         | PRIMINTEGER           { L1 $ HsIntPrim    $ getPRIMINTEGER $1 }
1474         | PRIMCHAR              { L1 $ HsCharPrim   $ getPRIMCHAR $1 }
1475         | PRIMSTRING            { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1476         | PRIMFLOAT             { L1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
1477         | PRIMDOUBLE            { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1478
1479 -----------------------------------------------------------------------------
1480 -- Layout
1481
1482 close :: { () }
1483         : vccurly               { () } -- context popped in lexer.
1484         | error                 {% popContext }
1485
1486 -----------------------------------------------------------------------------
1487 -- Miscellaneous (mostly renamings)
1488
1489 modid   :: { Located ModuleName }
1490         : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
1491         | QCONID                { L1 $ let (mod,c) = getQCONID $1 in
1492                                   mkModuleNameFS
1493                                    (mkFastString
1494                                      (unpackFS mod ++ '.':unpackFS c))
1495                                 }
1496
1497 commas :: { Int }
1498         : commas ','                    { $1 + 1 }
1499         | ','                           { 2 }
1500
1501 -----------------------------------------------------------------------------
1502
1503 {
1504 happyError :: P a
1505 happyError = srcParseFail
1506
1507 getVARID        (L _ (ITvarid    x)) = x
1508 getCONID        (L _ (ITconid    x)) = x
1509 getVARSYM       (L _ (ITvarsym   x)) = x
1510 getCONSYM       (L _ (ITconsym   x)) = x
1511 getQVARID       (L _ (ITqvarid   x)) = x
1512 getQCONID       (L _ (ITqconid   x)) = x
1513 getQVARSYM      (L _ (ITqvarsym  x)) = x
1514 getQCONSYM      (L _ (ITqconsym  x)) = x
1515 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
1516 getIPSPLITVARID (L _ (ITsplitipvarid x)) = x
1517 getCHAR         (L _ (ITchar     x)) = x
1518 getSTRING       (L _ (ITstring   x)) = x
1519 getINTEGER      (L _ (ITinteger  x)) = x
1520 getRATIONAL     (L _ (ITrational x)) = x
1521 getPRIMCHAR     (L _ (ITprimchar   x)) = x
1522 getPRIMSTRING   (L _ (ITprimstring x)) = x
1523 getPRIMINTEGER  (L _ (ITprimint    x)) = x
1524 getPRIMFLOAT    (L _ (ITprimfloat  x)) = x
1525 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
1526 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1527
1528 -- Utilities for combining source spans
1529 comb2 :: Located a -> Located b -> SrcSpan
1530 comb2 = combineLocs
1531
1532 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1533 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1534
1535 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1536 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1537                 combineSrcSpans (getLoc c) (getLoc d)
1538
1539 -- strict constructor version:
1540 {-# INLINE sL #-}
1541 sL :: SrcSpan -> a -> Located a
1542 sL span a = span `seq` L span a
1543
1544 -- Make a source location that is just the filename.  This seems slightly
1545 -- neater than trying to construct the span of the text within the file.
1546 fileSrcSpan :: P SrcSpan
1547 fileSrcSpan = do l <- getSrcLoc; return (mkGeneralSrcSpan (srcLocFile l))
1548 }