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