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