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