ghc/compiler/parser/Parser.y.pp

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