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