ghc/compiler/parser/Parser.y.pp

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