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