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