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