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