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