parser: Allow Lm (MODIFIER LETTER) category in identifiers
[ghc.git] / compiler / parser / Parser.y
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 {-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
12 {-# OPTIONS -Wwarn -w #-}
13 -- The above warning suppression flag is a temporary kludge.
14 -- While working on this module you are encouraged to remove it and fix
15 -- any warnings in the module. See
16 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
17 -- for details
18
19 -- | This module provides the generated Happy parser for Haskell. It exports
20 -- a number of parsers which may be used in any library that uses the GHC API.
21 -- A common usage pattern is to initialize the parser state with a given string
22 -- and then parse that string:
23 --
24 -- @
25 --     runParser :: DynFlags -> String -> P a -> ParseResult a
26 --     runParser flags str parser = unP parser parseState
27 --     where
28 --       filename = "\<interactive\>"
29 --       location = mkRealSrcLoc (mkFastString filename) 1 1
30 --       buffer = stringToStringBuffer str
31 --       parseState = mkPState flags buffer location
32 -- @
33 module Parser (parseModule, parseImport, parseStatement,
34                parseDeclaration, parseExpression, parsePattern,
35                parseTypeSignature,
36                parseStmt, parseIdentifier,
37                parseType, parseHeader) where
38
39 -- base
40 import Control.Monad    ( unless, liftM )
41 import GHC.Exts
42 import Data.Char
43 import Control.Monad    ( mplus )
44
45 -- compiler/hsSyn
46 import HsSyn
47
48 -- compiler/main
49 import HscTypes         ( IsBootInterface, WarningTxt(..) )
50 import DynFlags
51
52 -- compiler/utils
53 import OrdList
54 import BooleanFormula   ( BooleanFormula(..), mkTrue )
55 import FastString
56 import Maybes           ( orElse )
57 import Outputable
58
59 -- compiler/basicTypes
60 import RdrName
61 import OccName          ( varName, dataName, tcClsName, tvName, startsWithUnderscore )
62 import DataCon          ( DataCon, dataConName )
63 import SrcLoc
64 import Module
65 import BasicTypes
66
67 -- compiler/types
68 import Type             ( funTyCon )
69 import Kind             ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind )
70 import Class            ( FunDep )
71
72 -- compiler/parser
73 import RdrHsSyn
74 import Lexer
75 import HaddockUtils
76 import ApiAnnotation
77
78 -- compiler/typecheck
79 import TcEvidence       ( emptyTcEvBinds )
80
81 -- compiler/prelude
82 import ForeignCall
83 import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
84 import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
85                           unboxedUnitTyCon, unboxedUnitDataCon,
86                           listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
87
88 -- compiler/utils
89 import Util             ( looksLikePackageName )
90
91 }
92
93 {- Last updated: 21 Jun 2015
94
95 Conflicts: 49 shift/reduce
96            6  reduce/reduce
97
98 If you modify this parser and add a conflict, please update this comment.
99 You can learn more about the conflicts by passing 'happy' the -i flag:
100
101     happy -agc --strict compiler/parser/Parser.y -idetailed-info
102
103 How is this section formatted? Look up the state the conflict is
104 reported at, and copy the list of applicable rules (at the top).  Mark
105 *** for the rule that is the conflicting reduction (that is, the
106 interpretation which is NOT taken).  NB: Happy doesn't print a rule in a
107 state if it is empty, but you should include it in the list (you can
108 look these up in the Grammar section of the info file).
109
110 Obviously the state numbers are not stable across modifications to the parser,
111 the idea is to reproduce enough information on each conflict so you can figure
112 out what happened if the states were renumbered.  Try not to gratuitously move
113 productions around in this file.  It's probably less important to keep
114 the rule annotations up-to-date.
115
116 -------------------------------------------------------------------------------
117
118 state 0 contains 1 shift/reduce conflicts.
119
120     Conflicts: DOCNEXT (empty missing_module_keyword reduces)
121
122 Ambiguity when the source file starts with "-- | doc". We need another
123 token of lookahead to determine if a top declaration or the 'module' keyword
124 follows. Shift parses as if the 'module' keyword follows.
125
126 -------------------------------------------------------------------------------
127
128 state 49 contains 11 shift/reduce conflicts.
129
130         context -> btype . '~' btype                        (rule 279)
131         context -> btype .                                  (rule 280)
132     *** type -> btype .                                     (rule 281)
133         type -> btype . qtyconop type                       (rule 282)
134         type -> btype . tyvarop type                        (rule 283)
135         type -> btype . '->' ctype                          (rule 284)
136         type -> btype . '~' btype                           (rule 285)
137         type -> btype . SIMPLEQUOTE qconop type             (rule 286)
138         type -> btype . SIMPLEQUOTE varop type              (rule 287)
139         btype -> btype . atype                              (rule 299)
140
141     Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
142
143 Example of ambiguity: 'e :: a `b` c';  does this mean
144     (e::a) `b` c, or
145     (e :: (a `b` c))
146
147 The case for '->' involves view patterns rather than type operators:
148     'case v of { x :: T -> T ... } '
149     Which of these two is intended?
150           case v of
151             (x::T) -> T         -- Rhs is T
152     or
153           case v of
154             (x::T -> T) -> ..   -- Rhs is ...
155
156 -------------------------------------------------------------------------------
157
158 state 120 contains 15 shift/reduce conflicts.
159
160         exp -> infixexp . '::' sigtype                      (rule 414)
161         exp -> infixexp . '-<' exp                          (rule 415)
162         exp -> infixexp . '>-' exp                          (rule 416)
163         exp -> infixexp . '-<<' exp                         (rule 417)
164         exp -> infixexp . '>>-' exp                         (rule 418)
165     *** exp -> infixexp .                                   (rule 419)
166         infixexp -> infixexp . qop exp10                    (rule 421)
167
168     Conflicts: ':' '::' '-' '!' '*' '-<' '>-' '-<<' '>>-'
169                '.' '`' VARSYM CONSYM QVARSYM QCONSYM
170
171 Examples of ambiguity:
172     'if x then y else z -< e'
173     'if x then y else z :: T'
174     'if x then y else z + 1' (NB: '+' is in VARSYM)
175
176 Shift parses as (per longest-parse rule):
177     'if x then y else (z -< T)'
178     'if x then y else (z :: T)'
179     'if x then y else (z + 1)'
180
181 -------------------------------------------------------------------------------
182
183 state 281 contains 1 shift/reduce conflicts.
184
185         rule -> STRING . rule_activation rule_forall infixexp '=' exp    (rule 214)
186
187     Conflict: '[' (empty rule_activation reduces)
188
189 We don't know whether the '[' starts the activation or not: it
190 might be the start of the declaration with the activation being
191 empty.  --SDM 1/4/2002
192
193 Example ambiguity:
194     '{-# RULE [0] f = ... #-}'
195
196 We parse this as having a [0] rule activation for rewriting 'f', rather
197 a rule instructing how to rewrite the expression '[0] f'.
198
199 -------------------------------------------------------------------------------
200
201 state 290 contains 11 shift/reduce conflicts.
202
203     *** type -> btype .                                     (rule 281)
204         type -> btype . qtyconop type                       (rule 282)
205         type -> btype . tyvarop type                        (rule 283)
206         type -> btype . '->' ctype                          (rule 284)
207         type -> btype . '~' btype                           (rule 285)
208         type -> btype . SIMPLEQUOTE qconop type             (rule 286)
209         type -> btype . SIMPLEQUOTE varop type              (rule 287)
210         btype -> btype . atype                              (rule 299)
211
212     Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
213
214 Same as State 49, but minus the context productions.
215
216 -------------------------------------------------------------------------------
217
218 state 326 contains 1 shift/reduce conflicts.
219
220         tup_exprs -> commas . tup_tail                      (rule 502)
221         sysdcon -> '(' commas . ')'                         (rule 610)
222         commas -> commas . ','                              (rule 725)
223
224     Conflict: ')' (empty tup_tail reduces)
225
226 A tuple section with NO free variables '(,,)' is indistinguishable
227 from the Haskell98 data constructor for a tuple.  Shift resolves in
228 favor of sysdcon, which is good because a tuple section will get rejected
229 if -XTupleSections is not specified.
230
231 -------------------------------------------------------------------------------
232
233 state 378 contains 1 shift/reduce conflicts.
234
235         tup_exprs -> commas . tup_tail                      (rule 502)
236         sysdcon -> '(#' commas . '#)'                       (rule 612)
237         commas -> commas . ','                              (rule 724)
238
239     Conflict: '#)' (empty tup_tail reduces)
240
241 Same as State 320 for unboxed tuples.
242
243 -------------------------------------------------------------------------------
244
245 state 406 contains 1 shift/reduce conflicts.
246
247         exp10 -> 'let' binds . 'in' exp                     (rule 423)
248         exp10 -> 'let' binds . 'in' error                   (rule 438)
249         exp10 -> 'let' binds . error                        (rule 439)
250     *** qual -> 'let' binds .                               (rule 576)
251
252     Conflict: error
253
254 TODO: Why?
255
256 -------------------------------------------------------------------------------
257
258
259 state 470 contains 1 shift/reduce conflicts.
260
261     *** strict_mark -> '{-# NOUNPACK' '#-}' .               (rule 268)
262         strict_mark -> '{-# NOUNPACK' '#-}' . '!'           (rule 270)
263
264     Conflict: '!'
265
266 TODO: Why?
267
268 -------------------------------------------------------------------------------
269
270 state 471 contains 1 shift/reduce conflicts.
271
272     *** strict_mark -> '{-# UNPACK' '#-}' .                 (rule 267)
273         strict_mark -> '{-# UNPACK' '#-}' . '!'             (rule 269)
274
275     Conflict: '!'
276
277 Same as State 462
278
279 -------------------------------------------------------------------------------
280
281 state 502 contains 1 shift/reduce conflicts.
282
283         context -> btype '~' btype .                        (rule 279)
284     *** type -> btype '~' btype .                           (rule 285)
285         btype -> btype . atype                              (rule 299)
286
287     Conflict: '!'
288
289 TODO: Why?
290
291 -------------------------------------------------------------------------------
292
293 state 637 contains 1 shift/reduce conflicts.
294
295     *** aexp2 -> ipvar .                                    (rule 462)
296         dbind -> ipvar . '=' exp                            (rule 587)
297
298     Conflict: '='
299
300 Example ambiguity: 'let ?x ...'
301
302 The parser can't tell whether the ?x is the lhs of a normal binding or
303 an implicit binding.  Fortunately, resolving as shift gives it the only
304 sensible meaning, namely the lhs of an implicit binding.
305
306 -------------------------------------------------------------------------------
307
308 state 704 contains 1 shift/reduce conflicts.
309
310         rule -> STRING rule_activation . rule_forall infixexp '=' exp    (rule 214)
311
312     Conflict: 'forall' (empty rule_forall reduces)
313
314 Example ambiguity: '{-# RULES "name" forall = ... #-}'
315
316 'forall' is a valid variable name---we don't know whether
317 to treat a forall on the input as the beginning of a quantifier
318 or the beginning of the rule itself.  Resolving to shift means
319 it's always treated as a quantifier, hence the above is disallowed.
320 This saves explicitly defining a grammar for the rule lhs that
321 doesn't include 'forall'.
322
323 -------------------------------------------------------------------------------
324
325 state 775 contains 1 shift/reduce conflicts.
326
327     *** type -> btype '~' btype .                           (rule 285)
328         btype -> btype . atype                              (rule 299)
329
330     Conflict: '!'
331
332 TODO: Why?
333
334 -------------------------------------------------------------------------------
335
336 state 958 contains 1 shift/reduce conflicts.
337
338         transformqual -> 'then' 'group' . 'using' exp       (rule 525)
339         transformqual -> 'then' 'group' . 'by' exp 'using' exp    (rule 526)
340     *** special_id -> 'group' .                             (rule 701)
341
342     Conflict: 'by'
343
344 TODO: Why?
345
346 -------------------------------------------------------------------------------
347
348 state 1237 contains 1 reduce/reduce conflicts.
349
350     *** tyconsym -> ':' .                                   (rule 642)
351         consym -> ':' .                                     (rule 712)
352
353     Conflict: ')'
354
355 TODO: Same as State 1230
356
357 -------------------------------------------------------------------------------
358
359 state 1238 contains 1 reduce/reduce conflicts.
360
361     *** tyconsym -> CONSYM .                                (rule 640)
362         consym -> CONSYM .                                  (rule 711)
363
364     Conflict: ')'
365
366 TODO: Why?  (NB: This one has been around for a while; it's quite puzzling
367     because we really shouldn't get confused between tyconsym and consym.
368     Trace the state machine, maybe?)
369
370 -------------------------------------------------------------------------------
371 state 1259 contains 1 reduce/reduce conflicts.
372
373         *** tyconsym -> '-' .                                   (rule 651)
374         varsym -> '-' .                                         (rule 694)
375
376         Conflict : ')'
377
378 Introduced in "Refactor tuple constraints"
379       (ffc21506894c7887d3620423aaf86bc6113a1071)
380 -------------------------------------------------------------------------------
381 state 1260 contains 1 reduce/reduce conflicts.
382
383         *** tyconsym -> '-' .                                   (rule 651)
384         varsym -> '-' .                                         (rule 694)
385
386         Conflict: ')'
387
388 Same as 1259
389
390 -------------------------------------------------------------------------------
391 state 1261 contains 1 reduce/reduce conflicts.
392
393         *** tyconsym -> VARSYM .                                (rule 648)
394         varsym_no_minus -> VARSYM .                             (rule 695)
395
396   Conflict: ')'
397
398 Same as 1260
399
400 -------------------------------------------------------------------------------
401 state 1262 contains 1 reduce/reduce conflicts.
402
403         *** qtyconsym -> QVARSYM .                              (rule 645)
404         qvarsym1 -> QVARSYM .                                   (rule 692)
405
406         Conflict: ')'
407
408 Same as 1260
409
410 -- -----------------------------------------------------------------------------
411 -- API Annotations
412 --
413
414 A lot of the productions are now cluttered with calls to
415 aa,am,ams,amms etc.
416
417 These are helper functions to make sure that the locations of the
418 various keywords such as do / let / in are captured for use by tools
419 that want to do source to source conversions, such as refactorers or
420 structured editors.
421
422 The helper functions are defined at the bottom of this file.
423
424 See
425   https://ghc.haskell.org/trac/ghc/wiki/ApiAnnotations and
426   https://ghc.haskell.org/trac/ghc/wiki/GhcAstAnnotations
427 for some background.
428
429 -- -----------------------------------------------------------------------------
430
431 -}
432
433 %token
434  '_'            { L _ ITunderscore }            -- Haskell keywords
435  'as'           { L _ ITas }
436  'case'         { L _ ITcase }
437  'class'        { L _ ITclass }
438  'data'         { L _ ITdata }
439  'default'      { L _ ITdefault }
440  'deriving'     { L _ ITderiving }
441  'do'           { L _ ITdo }
442  'else'         { L _ ITelse }
443  'hiding'       { L _ IThiding }
444  'if'           { L _ ITif }
445  'import'       { L _ ITimport }
446  'in'           { L _ ITin }
447  'infix'        { L _ ITinfix }
448  'infixl'       { L _ ITinfixl }
449  'infixr'       { L _ ITinfixr }
450  'instance'     { L _ ITinstance }
451  'let'          { L _ ITlet }
452  'module'       { L _ ITmodule }
453  'newtype'      { L _ ITnewtype }
454  'of'           { L _ ITof }
455  'qualified'    { L _ ITqualified }
456  'then'         { L _ ITthen }
457  'type'         { L _ ITtype }
458  'where'        { L _ ITwhere }
459
460  'forall'       { L _ ITforall }                -- GHC extension keywords
461  'foreign'      { L _ ITforeign }
462  'export'       { L _ ITexport }
463  'label'        { L _ ITlabel }
464  'dynamic'      { L _ ITdynamic }
465  'safe'         { L _ ITsafe }
466  'interruptible' { L _ ITinterruptible }
467  'unsafe'       { L _ ITunsafe }
468  'mdo'          { L _ ITmdo }
469  'family'       { L _ ITfamily }
470  'role'         { L _ ITrole }
471  'stdcall'      { L _ ITstdcallconv }
472  'ccall'        { L _ ITccallconv }
473  'capi'         { L _ ITcapiconv }
474  'prim'         { L _ ITprimcallconv }
475  'javascript'   { L _ ITjavascriptcallconv }
476  'proc'         { L _ ITproc }          -- for arrow notation extension
477  'rec'          { L _ ITrec }           -- for arrow notation extension
478  'group'    { L _ ITgroup }     -- for list transform extension
479  'by'       { L _ ITby }        -- for list transform extension
480  'using'    { L _ ITusing }     -- for list transform extension
481  'pattern'      { L _ ITpattern } -- for pattern synonyms
482  'static'       { L _ ITstatic }  -- for static pointers extension
483
484  '{-# INLINE'             { L _ (ITinline_prag _ _ _) }
485  '{-# SPECIALISE'         { L _ (ITspec_prag _) }
486  '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _ _) }
487  '{-# SOURCE'             { L _ (ITsource_prag _) }
488  '{-# RULES'              { L _ (ITrules_prag _) }
489  '{-# CORE'               { L _ (ITcore_prag _) }      -- hdaume: annotated core
490  '{-# SCC'                { L _ (ITscc_prag _)}
491  '{-# GENERATED'          { L _ (ITgenerated_prag _) }
492  '{-# DEPRECATED'         { L _ (ITdeprecated_prag _) }
493  '{-# WARNING'            { L _ (ITwarning_prag _) }
494  '{-# UNPACK'             { L _ (ITunpack_prag _) }
495  '{-# NOUNPACK'           { L _ (ITnounpack_prag _) }
496  '{-# ANN'                { L _ (ITann_prag _) }
497  '{-# VECTORISE'          { L _ (ITvect_prag _) }
498  '{-# VECTORISE_SCALAR'   { L _ (ITvect_scalar_prag _) }
499  '{-# NOVECTORISE'        { L _ (ITnovect_prag _) }
500  '{-# MINIMAL'            { L _ (ITminimal_prag _) }
501  '{-# CTYPE'              { L _ (ITctype _) }
502  '{-# OVERLAPPING'        { L _ (IToverlapping_prag _) }
503  '{-# OVERLAPPABLE'       { L _ (IToverlappable_prag _) }
504  '{-# OVERLAPS'           { L _ (IToverlaps_prag _) }
505  '{-# INCOHERENT'         { L _ (ITincoherent_prag _) }
506  '#-}'                    { L _ ITclose_prag }
507
508  '..'           { L _ ITdotdot }                        -- reserved symbols
509  ':'            { L _ ITcolon }
510  '::'           { L _ ITdcolon }
511  '='            { L _ ITequal }
512  '\\'           { L _ ITlam }
513  'lcase'        { L _ ITlcase }
514  '|'            { L _ ITvbar }
515  '<-'           { L _ ITlarrow }
516  '->'           { L _ ITrarrow }
517  '@'            { L _ ITat }
518  '~'            { L _ ITtilde }
519  '~#'           { L _ ITtildehsh }
520  '=>'           { L _ ITdarrow }
521  '-'            { L _ ITminus }
522  '!'            { L _ ITbang }
523  '*'            { L _ ITstar }
524  '-<'           { L _ ITlarrowtail }            -- for arrow notation
525  '>-'           { L _ ITrarrowtail }            -- for arrow notation
526  '-<<'          { L _ ITLarrowtail }            -- for arrow notation
527  '>>-'          { L _ ITRarrowtail }            -- for arrow notation
528  '.'            { L _ ITdot }
529
530  '{'            { L _ ITocurly }                        -- special symbols
531  '}'            { L _ ITccurly }
532  vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
533  vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
534  '['            { L _ ITobrack }
535  ']'            { L _ ITcbrack }
536  '[:'           { L _ ITopabrack }
537  ':]'           { L _ ITcpabrack }
538  '('            { L _ IToparen }
539  ')'            { L _ ITcparen }
540  '(#'           { L _ IToubxparen }
541  '#)'           { L _ ITcubxparen }
542  '(|'           { L _ IToparenbar }
543  '|)'           { L _ ITcparenbar }
544  ';'            { L _ ITsemi }
545  ','            { L _ ITcomma }
546  '`'            { L _ ITbackquote }
547  SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x
548
549  VARID          { L _ (ITvarid    _) }          -- identifiers
550  CONID          { L _ (ITconid    _) }
551  VARSYM         { L _ (ITvarsym   _) }
552  CONSYM         { L _ (ITconsym   _) }
553  QVARID         { L _ (ITqvarid   _) }
554  QCONID         { L _ (ITqconid   _) }
555  QVARSYM        { L _ (ITqvarsym  _) }
556  QCONSYM        { L _ (ITqconsym  _) }
557  PREFIXQVARSYM  { L _ (ITprefixqvarsym  _) }
558  PREFIXQCONSYM  { L _ (ITprefixqconsym  _) }
559
560  IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
561
562  CHAR           { L _ (ITchar   _ _) }
563  STRING         { L _ (ITstring _ _) }
564  INTEGER        { L _ (ITinteger _ _) }
565  RATIONAL       { L _ (ITrational _) }
566
567  PRIMCHAR       { L _ (ITprimchar   _ _) }
568  PRIMSTRING     { L _ (ITprimstring _ _) }
569  PRIMINTEGER    { L _ (ITprimint    _ _) }
570  PRIMWORD       { L _ (ITprimword   _ _) }
571  PRIMFLOAT      { L _ (ITprimfloat  _) }
572  PRIMDOUBLE     { L _ (ITprimdouble _) }
573
574  DOCNEXT        { L _ (ITdocCommentNext _) }
575  DOCPREV        { L _ (ITdocCommentPrev _) }
576  DOCNAMED       { L _ (ITdocCommentNamed _) }
577  DOCSECTION     { L _ (ITdocSection _ _) }
578
579 -- Template Haskell
580 '[|'            { L _ ITopenExpQuote  }
581 '[p|'           { L _ ITopenPatQuote  }
582 '[t|'           { L _ ITopenTypQuote  }
583 '[d|'           { L _ ITopenDecQuote  }
584 '|]'            { L _ ITcloseQuote    }
585 '[||'           { L _ ITopenTExpQuote   }
586 '||]'           { L _ ITcloseTExpQuote  }
587 TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
588 '$('            { L _ ITparenEscape   }     -- $( exp )
589 TH_ID_TY_SPLICE { L _ (ITidTyEscape _)  }   -- $$x
590 '$$('           { L _ ITparenTyEscape   }   -- $$( exp )
591 TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
592 TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
593 TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
594
595 %monad { P } { >>= } { return }
596 %lexer { (lexer True) } { L _ ITeof }
597 %tokentype { (Located Token) }
598
599 -- Exported parsers
600 %name parseModule module
601 %name parseImport importdecl
602 %name parseStatement stmt
603 %name parseDeclaration topdecl
604 %name parseExpression exp
605 %name parsePattern pat
606 %name parseTypeSignature sigdecl
607 %name parseStmt   maybe_stmt
608 %name parseIdentifier  identifier
609 %name parseType ctype
610 %partial parseHeader header
611 %%
612
613 -----------------------------------------------------------------------------
614 -- Identifiers; one of the entry points
615 identifier :: { Located RdrName }
616         : qvar                          { $1 }
617         | qcon                          { $1 }
618         | qvarop                        { $1 }
619         | qconop                        { $1 }
620     | '(' '->' ')'      {% ams (sLL $1 $> $ getRdrName funTyCon)
621                                [mj AnnOpenP $1,mj AnnRarrow $2,mj AnnCloseP $3] }
622
623 -----------------------------------------------------------------------------
624 -- Module Header
625
626 -- The place for module deprecation is really too restrictive, but if it
627 -- was allowed at its natural place just before 'module', we get an ugly
628 -- s/r conflict with the second alternative. Another solution would be the
629 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
630 -- either, and DEPRECATED is only expected to be used by people who really
631 -- know what they are doing. :-)
632
633 module :: { Located (HsModule RdrName) }
634        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
635              {% fileSrcSpan >>= \ loc ->
636                 ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
637                               (snd $ snd $7) $4 $1)
638                     )
639                     ([mj AnnModule $2, mj AnnWhere $6] ++ fst $7) }
640         | body2
641                 {% fileSrcSpan >>= \ loc ->
642                    ams (L loc (HsModule Nothing Nothing
643                                (fst $ snd $1) (snd $ snd $1) Nothing Nothing))
644                        (fst $1) }
645
646 maybedocheader :: { Maybe LHsDocString }
647         : moduleheader            { $1 }
648         | {- empty -}             { Nothing }
649
650 missing_module_keyword :: { () }
651         : {- empty -}                           {% pushCurrentContext }
652
653 maybemodwarning :: { Maybe (Located WarningTxt) }
654     : '{-# DEPRECATED' strings '#-}'
655                       {% ajs (Just (sLL $1 $> $ DeprecatedTxt (sL1 $1 (getDEPRECATED_PRAGs $1)) (snd $ unLoc $2)))
656                              (mo $1:mc $3: (fst $ unLoc $2)) }
657     | '{-# WARNING' strings '#-}'
658                          {% ajs (Just (sLL $1 $> $ WarningTxt (sL1 $1 (getWARNING_PRAGs $1)) (snd $ unLoc $2)))
659                                 (mo $1:mc $3 : (fst $ unLoc $2)) }
660     |  {- empty -}                  { Nothing }
661
662 body    :: { ([AddAnn]
663              ,([LImportDecl RdrName], [LHsDecl RdrName])) }
664         :  '{'            top '}'      { (moc $1:mcc $3:(fst $2)
665                                          , snd $2) }
666         |      vocurly    top close    { (fst $2, snd $2) }
667
668 body2   :: { ([AddAnn]
669              ,([LImportDecl RdrName], [LHsDecl RdrName])) }
670         :  '{' top '}'                          { (moc $1:mcc $3
671                                                    :(fst $2), snd $2) }
672         |  missing_module_keyword top close     { ([],snd $2) }
673
674 top     :: { ([AddAnn]
675              ,([LImportDecl RdrName], [LHsDecl RdrName])) }
676         : importdecls                   { (fst $1
677                                           ,(reverse $ snd $1,[]))}
678         | importdecls ';' cvtopdecls    {% if null (snd $1)
679                                              then return ((mj AnnSemi $2:(fst $1))
680                                                          ,(reverse $ snd $1,$3))
681                                              else do
682                                               { addAnnotation (gl $ head $ snd $1)
683                                                               AnnSemi (gl $2)
684                                               ; return (fst $1
685                                                        ,(reverse $ snd $1,$3)) }}
686         | cvtopdecls                    { ([],([],$1)) }
687
688 cvtopdecls :: { [LHsDecl RdrName] }
689         : topdecls                              { cvTopDecls $1 }
690
691 -----------------------------------------------------------------------------
692 -- Module declaration & imports only
693
694 header  :: { Located (HsModule RdrName) }
695         : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
696                 {% fileSrcSpan >>= \ loc ->
697                    ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
698                           )) [mj AnnModule $2,mj AnnWhere $6] }
699         | header_body2
700                 {% fileSrcSpan >>= \ loc ->
701                    return (L loc (HsModule Nothing Nothing $1 [] Nothing
702                           Nothing)) }
703
704 header_body :: { [LImportDecl RdrName] }
705         :  '{'            importdecls           { snd $2 }
706         |      vocurly    importdecls           { snd $2 }
707
708 header_body2 :: { [LImportDecl RdrName] }
709         :  '{' importdecls                      { snd $2 }
710         |  missing_module_keyword importdecls   { snd $2 }
711
712 -----------------------------------------------------------------------------
713 -- The Export List
714
715 maybeexports :: { (Maybe (Located [LIE RdrName])) }
716         :  '(' exportlist ')'       {% ams (sLL $1 $> ()) [mop $1,mcp $3] >>
717                                        return (Just (sLL $1 $> (fromOL $2))) }
718         |  {- empty -}              { Nothing }
719
720 exportlist :: { OrdList (LIE RdrName) }
721         : expdoclist ',' expdoclist   {% addAnnotation (oll $1) AnnComma (gl $2)
722                                          >> return ($1 `appOL` $3) }
723         | exportlist1                 { $1 }
724
725 exportlist1 :: { OrdList (LIE RdrName) }
726         : expdoclist export expdoclist ',' exportlist1
727                           {% (addAnnotation (oll ($1 `appOL` $2 `appOL` $3))
728                                             AnnComma (gl $4) ) >>
729                               return ($1 `appOL` $2 `appOL` $3 `appOL` $5) }
730         | expdoclist export expdoclist             { $1 `appOL` $2 `appOL` $3 }
731         | expdoclist                               { $1 }
732
733 expdoclist :: { OrdList (LIE RdrName) }
734         : exp_doc expdoclist                           { $1 `appOL` $2 }
735         | {- empty -}                                  { nilOL }
736
737 exp_doc :: { OrdList (LIE RdrName) }
738         : docsection    { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup n doc)) }
739         | docnamed      { unitOL (sL1 $1 (IEDocNamed ((fst . unLoc) $1))) }
740         | docnext       { unitOL (sL1 $1 (IEDoc (unLoc $1))) }
741
742
743    -- No longer allow things like [] and (,,,) to be exported
744    -- They are built in syntax, always available
745 export  :: { OrdList (LIE RdrName) }
746         : qcname_ext export_subspec  {% amsu (sLL $1 $> (mkModuleImpExp $1
747                                                     (snd $ unLoc $2)))
748                                              (fst $ unLoc $2) }
749         |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents $2))
750                                              [mj AnnModule $1] }
751         |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar $2))
752                                              [mj AnnPattern $1] }
753
754 export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
755         : {- empty -}             { sL0 ([],ImpExpAbs) }
756         | '(' '..' ')'            { sLL $1 $> ([mop $1,mcp $3,mj AnnDotdot $2]
757                                        , ImpExpAll) }
758         | '(' ')'                 { sLL $1 $> ([mop $1,mcp $2],ImpExpList []) }
759         | '(' qcnames ')'         { sLL $1 $> ([mop $1,mcp $3],ImpExpList (reverse $2)) }
760
761 qcnames :: { [Located RdrName] }     -- A reversed list
762         :  qcnames ',' qcname_ext       {% (aa (head $1) (AnnComma, $2)) >>
763                                            return ($3  : $1) }
764         |  qcname_ext                   { [$1]  }
765
766 qcname_ext :: { Located RdrName }       -- Variable or data constructor
767                                         -- or tagged type constructor
768         :  qcname                   { $1 }
769         |  'type' qcname            {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
770                                             [mj AnnType $1,mj AnnVal $2] }
771
772 qcname  :: { Located RdrName }  -- Variable or type constructor
773         :  qvar                         { $1 }
774         |  oqtycon                      { $1 }
775
776 -----------------------------------------------------------------------------
777 -- Import Declarations
778
779 -- import decls can be *empty*, or even just a string of semicolons
780 -- whereas topdecls must contain at least one topdecl.
781
782 importdecls :: { ([AddAnn],[LImportDecl RdrName]) }
783         : importdecls ';' importdecl
784                                 {% if null (snd $1)
785                                      then return (mj AnnSemi $2:fst $1,$3 : snd $1)
786                                      else do
787                                       { addAnnotation (gl $ head $ snd $1)
788                                                       AnnSemi (gl $2)
789                                       ; return (fst $1,$3 : snd $1) } }
790         | importdecls ';'       {% if null (snd $1)
791                                      then return ((mj AnnSemi $2:fst $1),snd $1)
792                                      else do
793                                        { addAnnotation (gl $ head $ snd $1)
794                                                        AnnSemi (gl $2)
795                                        ; return $1} }
796         | importdecl             { ([],[$1]) }
797         | {- empty -}            { ([],[]) }
798
799 importdecl :: { LImportDecl RdrName }
800         : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
801                 {% ams (L (comb4 $1 $6 (snd $7) $8) $
802                   ImportDecl { ideclSourceSrc = snd $ fst $2
803                              , ideclName = $6, ideclPkgQual = snd $5
804                              , ideclSource = snd $2, ideclSafe = snd $3
805                              , ideclQualified = snd $4, ideclImplicit = False
806                              , ideclAs = unLoc (snd $7)
807                              , ideclHiding = unLoc $8 })
808                    ((mj AnnImport $1 : (fst $ fst $2) ++ fst $3 ++ fst $4
809                                     ++ fst $5 ++ fst $7)) }
810
811 maybe_src :: { (([AddAnn],Maybe SourceText),IsBootInterface) }
812         : '{-# SOURCE' '#-}'        { (([mo $1,mc $2],Just (getSOURCE_PRAGs $1))
813                                       ,True) }
814         | {- empty -}               { (([],Nothing),False) }
815
816 maybe_safe :: { ([AddAnn],Bool) }
817         : 'safe'                                { ([mj AnnSafe $1],True) }
818         | {- empty -}                           { ([],False) }
819
820 maybe_pkg :: { ([AddAnn],Maybe (SourceText,FastString)) }
821         : STRING  {% let pkgFS = getSTRING $1 in
822                      if looksLikePackageName (unpackFS pkgFS)
823                         then return ([mj AnnPackageName $1], Just (getSTRINGs $1,pkgFS))
824                         else parseErrorSDoc (getLoc $1) $ vcat [
825                              text "parse error" <> colon <+> quotes (ppr pkgFS),
826                              text "Version number or non-alphanumeric" <+>
827                              text "character in package name"] }
828         | {- empty -}                           { ([],Nothing) }
829
830 optqualified :: { ([AddAnn],Bool) }
831         : 'qualified'                           { ([mj AnnQualified $1],True)  }
832         | {- empty -}                           { ([],False) }
833
834 maybeas :: { ([AddAnn],Located (Maybe ModuleName)) }
835         : 'as' modid                           { ([mj AnnAs $1,mj AnnVal $2]
836                                                  ,sLL $1 $> (Just (unLoc $2))) }
837         | {- empty -}                          { ([],noLoc Nothing) }
838
839 maybeimpspec :: { Located (Maybe (Bool, Located [LIE RdrName])) }
840         : impspec                  { L (gl $1) (Just (unLoc $1)) }
841         | {- empty -}              { noLoc Nothing }
842
843 impspec :: { Located (Bool, Located [LIE RdrName]) }
844         :  '(' exportlist ')'               {% ams (sLL $1 $> (False,
845                                                       sLL $1 $> $ fromOL $2))
846                                                    [mop $1,mcp $3] }
847         |  'hiding' '(' exportlist ')'      {% ams (sLL $1 $> (True,
848                                                       sLL $1 $> $ fromOL $3))
849                                                [mj AnnHiding $1,mop $2,mcp $4] }
850
851 -----------------------------------------------------------------------------
852 -- Fixity Declarations
853
854 prec    :: { Located Int }
855         : {- empty -}           { noLoc 9 }
856         | INTEGER
857                  {% checkPrecP (sL1 $1 (fromInteger (getINTEGER $1))) }
858
859 infix   :: { Located FixityDirection }
860         : 'infix'                               { sL1 $1 InfixN  }
861         | 'infixl'                              { sL1 $1 InfixL  }
862         | 'infixr'                              { sL1 $1 InfixR }
863
864 ops     :: { Located (OrdList (Located RdrName)) }
865         : ops ',' op       {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
866                               return (sLL $1 $> ((unLoc $1) `appOL` unitOL $3))}
867         | op               { sL1 $1 (unitOL $1) }
868
869 -----------------------------------------------------------------------------
870 -- Top-Level Declarations
871
872 topdecls :: { OrdList (LHsDecl RdrName) }
873         : topdecls ';' topdecl        {% addAnnotation (oll $1) AnnSemi (gl $2)
874                                          >> return ($1 `appOL` unitOL $3) }
875         | topdecls ';'                {% addAnnotation (oll $1) AnnSemi (gl $2)
876                                          >> return $1 }
877         | topdecl                     { unitOL $1 }
878
879 topdecl :: { LHsDecl RdrName }
880         : cl_decl                               { sL1 $1 (TyClD (unLoc $1)) }
881         | ty_decl                               { sL1 $1 (TyClD (unLoc $1)) }
882         | inst_decl                             { sL1 $1 (InstD (unLoc $1)) }
883         | stand_alone_deriving                  { sLL $1 $> (DerivD (unLoc $1)) }
884         | role_annot                            { sL1 $1 (RoleAnnotD (unLoc $1)) }
885         | 'default' '(' comma_types0 ')'    {% ams (sLL $1 $> (DefD (DefaultDecl $3)))
886                                                          [mj AnnDefault $1
887                                                          ,mop $2,mcp $4] }
888         | 'foreign' fdecl          {% ams (sLL $1 $> (snd $ unLoc $2))
889                                            (mj AnnForeign $1:(fst $ unLoc $2)) }
890         | '{-# DEPRECATED' deprecations '#-}'   {% ams (sLL $1 $> $ WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2)))
891                                                        [mo $1,mc $3] }
892         | '{-# WARNING' warnings '#-}'          {% ams (sLL $1 $> $ WarningD (Warnings (getWARNING_PRAGs $1) (fromOL $2)))
893                                                        [mo $1,mc $3] }
894         | '{-# RULES' rules '#-}'               {% ams (sLL $1 $> $ RuleD (HsRules (getRULES_PRAGs $1) (fromOL $2)))
895                                                        [mo $1,mc $3] }
896         | '{-# VECTORISE' qvar '=' exp '#-}' {% ams (sLL $1 $> $ VectD (HsVect (getVECT_PRAGs $1) $2 $4))
897                                                     [mo $1,mj AnnEqual $3
898                                                     ,mc $5] }
899         | '{-# NOVECTORISE' qvar '#-}'       {% ams (sLL $1 $> $ VectD (HsNoVect (getNOVECT_PRAGs $1) $2))
900                                                      [mo $1,mc $3] }
901         | '{-# VECTORISE' 'type' gtycon '#-}'
902                                 {% ams (sLL $1 $> $
903                                     VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 Nothing))
904                                     [mo $1,mj AnnType $2,mc $4] }
905
906         | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
907                                 {% ams (sLL $1 $> $
908                                     VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 Nothing))
909                                     [mo $1,mj AnnType $2,mc $4] }
910
911         | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
912                                 {% ams (sLL $1 $> $
913                                     VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 (Just $5)))
914                                     [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
915         | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
916                                 {% ams (sLL $1 $> $
917                                     VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 (Just $5)))
918                                     [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
919
920         | '{-# VECTORISE' 'class' gtycon '#-}'
921                                          {% ams (sLL $1 $>  $ VectD (HsVectClassIn (getVECT_PRAGs $1) $3))
922                                                  [mo $1,mj AnnClass $2,mc $4] }
923         | annotation { $1 }
924         | decl_no_th                            { $1 }
925
926         -- Template Haskell Extension
927         -- The $(..) form is one possible form of infixexp
928         -- but we treat an arbitrary expression just as if
929         -- it had a $(..) wrapped around it
930         | infixexp                              { sLL $1 $> $ mkSpliceDecl $1 }
931
932 -- Type classes
933 --
934 cl_decl :: { LTyClDecl RdrName }
935         : 'class' tycl_hdr fds where_cls
936                 {% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))
937                         (mj AnnClass $1:(fst $ unLoc $3)++(fst $ unLoc $4)) }
938
939 -- Type declarations (toplevel)
940 --
941 ty_decl :: { LTyClDecl RdrName }
942            -- ordinary type synonyms
943         : 'type' type '=' ctypedoc
944                 -- Note ctype, not sigtype, on the right of '='
945                 -- We allow an explicit for-all but we don't insert one
946                 -- in   type Foo a = (b,b)
947                 -- Instead we just say b is out of scope
948                 --
949                 -- Note the use of type for the head; this allows
950                 -- infix type constructors to be declared
951                 {% amms (mkTySynonym (comb2 $1 $4) $2 $4)
952                         [mj AnnType $1,mj AnnEqual $3] }
953
954            -- type family declarations
955         | 'type' 'family' type opt_kind_sig where_type_family
956                 -- Note the use of type for the head; this allows
957                 -- infix type constructors to be declared
958                 {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $5) $3
959                                    (snd $ unLoc $4))
960                         (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)++(fst $ unLoc $5)) }
961
962           -- ordinary data type or newtype declaration
963         | data_or_newtype capi_ctype tycl_hdr constrs deriving
964                 {% amms (mkTyData (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
965                            Nothing (reverse (snd $ unLoc $4))
966                                    (unLoc $5))
967                                    -- We need the location on tycl_hdr in case
968                                    -- constrs and deriving are both empty
969                         ((fst $ unLoc $1):(fst $ unLoc $4)) }
970
971           -- ordinary GADT declaration
972         | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
973                  gadt_constrlist
974                  deriving
975             {% amms (mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
976                             (snd $ unLoc $4) (snd $ unLoc $5) (unLoc $6) )
977                                    -- We need the location on tycl_hdr in case
978                                    -- constrs and deriving are both empty
979                     ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
980
981           -- data/newtype family
982         | 'data' 'family' type opt_kind_sig
983                 {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (snd $ unLoc $4))
984                         (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
985
986 inst_decl :: { LInstDecl RdrName }
987         : 'instance' overlap_pragma inst_type where_inst
988        {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
989              ; let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
990                                      , cid_sigs = sigs, cid_tyfam_insts = ats
991                                      , cid_overlap_mode = $2
992                                      , cid_datafam_insts = adts }
993              ; ams (L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid }))
994                    (mj AnnInstance $1 : (fst $ unLoc $4)) } }
995
996            -- type instance declarations
997         | 'type' 'instance' ty_fam_inst_eqn
998                 {% ams $3 (fst $ unLoc $3)
999                 >> amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
1000                     (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
1001
1002           -- data/newtype instance declaration
1003         | data_or_newtype 'instance' capi_ctype tycl_hdr constrs deriving
1004             {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 $4
1005                                       Nothing (reverse (snd  $ unLoc $5))
1006                                               (unLoc $6))
1007                     ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) }
1008
1009           -- GADT instance declaration
1010         | data_or_newtype 'instance' capi_ctype tycl_hdr opt_kind_sig
1011                  gadt_constrlist
1012                  deriving
1013             {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 $4
1014                                    (snd $ unLoc $5) (snd $ unLoc $6) (unLoc $7))
1015                     ((fst $ unLoc $1):mj AnnInstance $2
1016                        :(fst $ unLoc $5)++(fst $ unLoc $6)) }
1017
1018 overlap_pragma :: { Maybe (Located OverlapMode) }
1019   : '{-# OVERLAPPABLE'    '#-}' {% ajs (Just (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))))
1020                                        [mo $1,mc $2] }
1021   | '{-# OVERLAPPING'     '#-}' {% ajs (Just (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1))))
1022                                        [mo $1,mc $2] }
1023   | '{-# OVERLAPS'        '#-}' {% ajs (Just (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1))))
1024                                        [mo $1,mc $2] }
1025   | '{-# INCOHERENT'      '#-}' {% ajs (Just (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1))))
1026                                        [mo $1,mc $2] }
1027   | {- empty -}                 { Nothing }
1028
1029
1030 -- Closed type families
1031
1032 where_type_family :: { Located ([AddAnn],FamilyInfo RdrName) }
1033         : {- empty -}                      { noLoc ([],OpenTypeFamily) }
1034         | 'where' ty_fam_inst_eqn_list
1035                { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1036                     ,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }
1037
1038 ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn RdrName]) }
1039         :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ([moc $1,mcc $3]
1040                                                 ,Just (unLoc $2)) }
1041         | vocurly ty_fam_inst_eqns close   { let L loc _ = $2 in
1042                                              L loc ([],Just (unLoc $2)) }
1043         |     '{' '..' '}'                 { sLL $1 $> ([moc $1,mj AnnDotdot $2
1044                                                  ,mcc $3],Nothing) }
1045         | vocurly '..' close               { let L loc _ = $2 in
1046                                              L loc ([mj AnnDotdot $2],Nothing) }
1047
1048 ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
1049         : ty_fam_inst_eqns ';' ty_fam_inst_eqn
1050                                       {% asl (unLoc $1) $2 (snd $ unLoc $3)
1051                                          >> ams $3 (fst $ unLoc $3)
1052                                          >> return (sLL $1 $> ((snd $ unLoc $3) : unLoc $1)) }
1053         | ty_fam_inst_eqns ';'        {% addAnnotation (gl $1) AnnSemi (gl $2)
1054                                          >> return (sLL $1 $>  (unLoc $1)) }
1055         | ty_fam_inst_eqn             {% ams $1 (fst $ unLoc $1)
1056                                          >> return (sLL $1 $> [snd $ unLoc $1]) }
1057         | {- empty -}                 { noLoc [] }
1058
1059 ty_fam_inst_eqn :: { Located ([AddAnn],LTyFamInstEqn RdrName) }
1060         : type '=' ctype
1061                 -- Note the use of type for the head; this allows
1062                 -- infix type constructors and type patterns
1063               {% do { (eqn,ann) <- mkTyFamInstEqn $1 $3
1064                     ; return (sLL $1 $> (mj AnnEqual $2:ann, sLL $1 $> eqn))  } }
1065
1066 -- Associated type family declarations
1067 --
1068 -- * They have a different syntax than on the toplevel (no family special
1069 --   identifier).
1070 --
1071 -- * They also need to be separate from instances; otherwise, data family
1072 --   declarations without a kind signature cause parsing conflicts with empty
1073 --   data declarations.
1074 --
1075 at_decl_cls :: { LHsDecl RdrName }
1076         :  -- data family declarations, with optional 'family' keyword
1077           'data' opt_family type opt_kind_sig
1078                 {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
1079                                                   (snd $ unLoc $4)))
1080                         (mj AnnData $1:$2++(fst $ unLoc $4)) }
1081
1082            -- type family declarations, with optional 'family' keyword
1083            -- (can't use opt_instance because you get shift/reduce errors
1084         | 'type' type opt_kind_sig
1085                {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $2 $3)
1086                                                   OpenTypeFamily $2 (snd $ unLoc $3)))
1087                        (mj AnnType $1:(fst $ unLoc $3)) }
1088         | 'type' 'family' type opt_kind_sig
1089                {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4)
1090                                                   OpenTypeFamily $3 (snd $ unLoc $4)))
1091                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)) }
1092
1093            -- default type instances, with optional 'instance' keyword
1094         | 'type' ty_fam_inst_eqn
1095                 {% ams $2 (fst $ unLoc $2) >>
1096                    amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2)))
1097                         (mj AnnType $1:(fst $ unLoc $2)) }
1098         | 'type' 'instance' ty_fam_inst_eqn
1099                 {% ams $3 (fst $ unLoc $3) >>
1100                    amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3)))
1101                         (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
1102
1103 opt_family   :: { [AddAnn] }
1104               : {- empty -}   { [] }
1105               | 'family'      { [mj AnnFamily $1] }
1106
1107 -- Associated type instances
1108 --
1109 at_decl_inst :: { LInstDecl RdrName }
1110            -- type instance declarations
1111         : 'type' ty_fam_inst_eqn
1112                 -- Note the use of type for the head; this allows
1113                 -- infix type constructors and type patterns
1114                 {% ams $2 (fst $ unLoc $2) >>
1115                    amms (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2))
1116                         (mj AnnType $1:(fst $ unLoc $2)) }
1117
1118         -- data/newtype instance declaration
1119         | data_or_newtype capi_ctype tycl_hdr constrs deriving
1120                {% amms (mkDataFamInst (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
1121                                     Nothing (reverse (snd $ unLoc $4))
1122                                             (unLoc $5))
1123                        ((fst $ unLoc $1):(fst $ unLoc $4)) }
1124
1125         -- GADT instance declaration
1126         | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
1127                  gadt_constrlist
1128                  deriving
1129                 {% amms (mkDataFamInst (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2
1130                                 $3 (snd $ unLoc $4) (snd $ unLoc $5) (unLoc $6))
1131                         ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
1132
1133 data_or_newtype :: { Located (AddAnn,NewOrData) }
1134         : 'data'        { sL1 $1 (mj AnnData    $1,DataType) }
1135         | 'newtype'     { sL1 $1 (mj AnnNewtype $1,NewType) }
1136
1137 opt_kind_sig :: { Located ([AddAnn],Maybe (LHsKind RdrName)) }
1138         :                             { noLoc ([],Nothing) }
1139         | '::' kind                   { sLL $1 $> ([mj AnnDcolon $1],Just ($2)) }
1140
1141 -- tycl_hdr parses the header of a class or data type decl,
1142 -- which takes the form
1143 --      T a b
1144 --      Eq a => T a
1145 --      (Eq a, Ord b) => T a b
1146 --      T Int [a]                       -- for associated types
1147 -- Rather a lot of inlining here, else we get reduce/reduce errors
1148 tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
1149         : context '=>' type         {% addAnnotation (gl $1) AnnDarrow (gl $2)
1150                                        >> (return (sLL $1 $> (Just $1, $3)))
1151                                     }
1152         | type                      { sL1 $1 (Nothing, $1) }
1153
1154 capi_ctype :: { Maybe (Located CType) }
1155 capi_ctype : '{-# CTYPE' STRING STRING '#-}'
1156                        {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))
1157                                         (getSTRINGs $3,getSTRING $3))))
1158                               [mo $1,mj AnnHeader $2,mj AnnVal $3,mc $4] }
1159
1160            | '{-# CTYPE'        STRING '#-}'
1161                        {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) Nothing  (getSTRINGs $2, getSTRING $2))))
1162                               [mo $1,mj AnnVal $2,mc $3] }
1163
1164            |           { Nothing }
1165
1166 -----------------------------------------------------------------------------
1167 -- Stand-alone deriving
1168
1169 -- Glasgow extension: stand-alone deriving declarations
1170 stand_alone_deriving :: { LDerivDecl RdrName }
1171   : 'deriving' 'instance' overlap_pragma inst_type
1172                          {% do {
1173                                  let err = text "in the stand-alone deriving instance"
1174                                             <> colon <+> quotes (ppr $4)
1175                                ; ams (sLL $1 $> (DerivDecl $4 $3))
1176                                      [mj AnnDeriving $1,mj AnnInstance $2] }}
1177
1178 -----------------------------------------------------------------------------
1179 -- Role annotations
1180
1181 role_annot :: { LRoleAnnotDecl RdrName }
1182 role_annot : 'type' 'role' oqtycon maybe_roles
1183           {% amms (mkRoleAnnotDecl (comb3 $1 $3 $4) $3 (reverse (unLoc $4)))
1184                   [mj AnnType $1,mj AnnRole $2] }
1185
1186 -- Reversed!
1187 maybe_roles :: { Located [Located (Maybe FastString)] }
1188 maybe_roles : {- empty -}    { noLoc [] }
1189             | roles          { $1 }
1190
1191 roles :: { Located [Located (Maybe FastString)] }
1192 roles : role             { sLL $1 $> [$1] }
1193       | roles role       { sLL $1 $> $ $2 : unLoc $1 }
1194
1195 -- read it in as a varid for better error messages
1196 role :: { Located (Maybe FastString) }
1197 role : VARID             { sL1 $1 $ Just $ getVARID $1 }
1198      | '_'               { sL1 $1 Nothing }
1199
1200 -- Pattern synonyms
1201
1202 -- Glasgow extension: pattern synonyms
1203 pattern_synonym_decl :: { LHsDecl RdrName }
1204         : 'pattern' pattern_synonym_lhs '=' pat
1205          {%ams ( let (name, args) = $2
1206                  in sLL $1 $> . ValD $ mkPatSynBind name args $4
1207                                                     ImplicitBidirectional)
1208                [mj AnnPattern $1,mj AnnEqual $3]
1209          }
1210         | 'pattern' pattern_synonym_lhs '<-' pat
1211          {%ams (let (name, args) = $2
1212                 in sLL $1 $> . ValD $ mkPatSynBind name args $4 Unidirectional)
1213                [mj AnnPattern $1,mj AnnLarrow $3] }
1214         | 'pattern' pattern_synonym_lhs '<-' pat where_decls
1215             {% do { let (name, args) = $2
1216                   ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
1217                   ; ams (sLL $1 $> . ValD $
1218                            mkPatSynBind name args $4 (ExplicitBidirectional mg))
1219                         (mj AnnPattern $1:mj AnnLarrow $3:(fst $ unLoc $5))
1220                    }}
1221
1222 pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName)) }
1223         : con vars0 { ($1, PrefixPatSyn $2) }
1224         | varid consym varid { ($2, InfixPatSyn $1 $3) }
1225
1226 vars0 :: { [Located RdrName] }
1227         : {- empty -}                 { [] }
1228         | varid vars0                 { $1 : $2 }
1229
1230 where_decls :: { Located ([AddAnn]
1231                          , Located (OrdList (LHsDecl RdrName))) }
1232         : 'where' '{' decls '}'       { sLL $1 $> ((mj AnnWhere $1:moc $2
1233                                            :mcc $4:(fst $ unLoc $3)),sL1 $3 (snd $ unLoc $3)) }
1234         | 'where' vocurly decls close { L (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
1235                                           ,sL1 $3 (snd $ unLoc $3)) }
1236 pattern_synonym_sig :: { LSig RdrName }
1237         : 'pattern' con '::' ptype
1238             {% do { let (flag, qtvs, prov, req, ty) = snd $ unLoc $4
1239                   ; let sig = PatSynSig $2 (flag, mkHsQTvs qtvs) prov req ty
1240                   ; ams (sLL $1 $> $ sig)
1241                         (mj AnnPattern $1:mj AnnDcolon $3:(fst $ unLoc $4)) } }
1242
1243 ptype :: { Located ([AddAnn]
1244                   ,( HsExplicitFlag, [LHsTyVarBndr RdrName], LHsContext RdrName
1245                    , LHsContext RdrName, LHsType RdrName)) }
1246         : 'forall' tv_bndrs '.' ptype
1247             {% do { hintExplicitForall (getLoc $1)
1248                   ; let (_, qtvs', prov, req, ty) = snd $ unLoc $4
1249                   ; return $ sLL $1 $>
1250                                 ((mj AnnForall $1:mj AnnDot $3:(fst $ unLoc $4))
1251                                 ,(Explicit, $2 ++ qtvs', prov, req ,ty)) }}
1252         | context '=>' context '=>' type
1253             { sLL $1 $> ([mj AnnDarrow $2,mj AnnDarrow $4]
1254                         ,(Implicit, [], $1, $3, $5)) }
1255         | context '=>' type
1256             { sLL $1 $> ([mj AnnDarrow $2],(Implicit, [], $1, noLoc [], $3)) }
1257         | type
1258             { sL1 $1 ([],(Implicit, [], noLoc [], noLoc [], $1)) }
1259
1260 -----------------------------------------------------------------------------
1261 -- Nested declarations
1262
1263 -- Declaration in class bodies
1264 --
1265 decl_cls  :: { LHsDecl RdrName }
1266 decl_cls  : at_decl_cls                 { $1 }
1267           | decl                        { $1 }
1268
1269           -- A 'default' signature used with the generic-programming extension
1270           | 'default' infixexp '::' sigtypedoc
1271                     {% do { (TypeSig l ty _) <- checkValSig $2 $4
1272                           ; let err = text "in default signature" <> colon <+>
1273                                       quotes (ppr ty)
1274                           ; ams (sLL $1 $> $ SigD (GenericSig l ty))
1275                                 [mj AnnDefault $1,mj AnnDcolon $3] } }
1276
1277 decls_cls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }  -- Reversed
1278           : decls_cls ';' decl_cls      {% if isNilOL (snd $ unLoc $1)
1279                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1280                                                                     , unitOL $3))
1281                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
1282                                            >> return (sLL $1 $> (fst $ unLoc $1
1283                                                                 ,(snd $ unLoc $1) `appOL` unitOL $3)) }
1284           | decls_cls ';'               {% if isNilOL (snd $ unLoc $1)
1285                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1286                                                                                    ,snd $ unLoc $1))
1287                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
1288                                            >> return (sLL $1 $>  (unLoc $1)) }
1289           | decl_cls                    { sL1 $1 ([], unitOL $1) }
1290           | {- empty -}                 { noLoc ([],nilOL) }
1291
1292 decllist_cls
1293         :: { Located ([AddAnn]
1294                      , OrdList (LHsDecl RdrName)) }      -- Reversed
1295         : '{'         decls_cls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
1296                                              ,snd $ unLoc $2) }
1297         |     vocurly decls_cls close   { $2 }
1298
1299 -- Class body
1300 --
1301 where_cls :: { Located ([AddAnn]
1302                        ,(OrdList (LHsDecl RdrName))) }    -- Reversed
1303                                 -- No implicit parameters
1304                                 -- May have type declarations
1305         : 'where' decllist_cls          { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1306                                              ,snd $ unLoc $2) }
1307         | {- empty -}                   { noLoc ([],nilOL) }
1308
1309 -- Declarations in instance bodies
1310 --
1311 decl_inst  :: { Located (OrdList (LHsDecl RdrName)) }
1312 decl_inst  : at_decl_inst               { sLL $1 $> (unitOL (sL1 $1 (InstD (unLoc $1)))) }
1313            | decl                       { sLL $1 $> (unitOL $1) }
1314
1315 decls_inst :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }   -- Reversed
1316            : decls_inst ';' decl_inst   {% if isNilOL (snd $ unLoc $1)
1317                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1318                                                                     , unLoc $3))
1319                                              else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1320                                            >> return
1321                                             (sLL $1 $> (fst $ unLoc $1
1322                                                        ,(snd $ unLoc $1) `appOL` unLoc $3)) }
1323            | decls_inst ';'             {% if isNilOL (snd $ unLoc $1)
1324                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1325                                                                                    ,snd $ unLoc $1))
1326                                              else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1327                                            >> return (sLL $1 $> (unLoc $1)) }
1328            | decl_inst                  { sL1 $1 ([],unLoc $1) }
1329            | {- empty -}                { noLoc ([],nilOL) }
1330
1331 decllist_inst
1332         :: { Located ([AddAnn]
1333                      , OrdList (LHsDecl RdrName)) }      -- Reversed
1334         : '{'         decls_inst '}'    { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) }
1335         |     vocurly decls_inst close  { L (gl $2) (unLoc $2) }
1336
1337 -- Instance body
1338 --
1339 where_inst :: { Located ([AddAnn]
1340                         , OrdList (LHsDecl RdrName)) }   -- Reversed
1341                                 -- No implicit parameters
1342                                 -- May have type declarations
1343         : 'where' decllist_inst         { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1344                                              ,(snd $ unLoc $2)) }
1345         | {- empty -}                   { noLoc ([],nilOL) }
1346
1347 -- Declarations in binding groups other than classes and instances
1348 --
1349 decls   :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
1350         : decls ';' decl    {% if isNilOL (snd $ unLoc $1)
1351                                  then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1352                                                         , unitOL $3))
1353                                  else do ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1354                                            >> return (
1355                                           let { this = unitOL $3;
1356                                                 rest = snd $ unLoc $1;
1357                                                 these = rest `appOL` this }
1358                                           in rest `seq` this `seq` these `seq`
1359                                              (sLL $1 $> (fst $ unLoc $1,these))) }
1360         | decls ';'          {% if isNilOL (snd $ unLoc $1)
1361                                   then return (sLL $1 $> ((mj AnnSemi $2:(fst $ unLoc $1)
1362                                                           ,snd $ unLoc $1)))
1363                                   else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1364                                            >> return (sLL $1 $> (unLoc $1)) }
1365         | decl                          { sL1 $1 ([], unitOL $1) }
1366         | {- empty -}                   { noLoc ([],nilOL) }
1367
1368 decllist :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
1369         : '{'            decls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
1370                                                    ,snd $ unLoc $2) }
1371         |     vocurly    decls close   { L (gl $2) (fst $ unLoc $2,snd $ unLoc $2) }
1372
1373 -- Binding groups other than those of class and instance declarations
1374 --
1375 binds   ::  { Located ([AddAnn],HsLocalBinds RdrName) }
1376                                          -- May have implicit parameters
1377                                                 -- No type declarations
1378         : decllist          {% do { val_binds <- cvBindGroup (snd $ unLoc $1)
1379                                   ; return (sL1 $1 (fst $ unLoc $1
1380                                                     ,HsValBinds val_binds)) } }
1381
1382         | '{'            dbinds '}'     { sLL $1 $> ([moc $1,mcc $3]
1383                                              ,HsIPBinds (IPBinds (unLoc $2)
1384                                                          emptyTcEvBinds)) }
1385
1386         |     vocurly    dbinds close   { L (getLoc $2) ([]
1387                                             ,HsIPBinds (IPBinds (unLoc $2)
1388                                                         emptyTcEvBinds)) }
1389
1390
1391 wherebinds :: { Located ([AddAnn],HsLocalBinds RdrName) }
1392                                                 -- May have implicit parameters
1393                                                 -- No type declarations
1394         : 'where' binds                 { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2)
1395                                              ,snd $ unLoc $2) }
1396         | {- empty -}                   { noLoc ([],emptyLocalBinds) }
1397
1398
1399 -----------------------------------------------------------------------------
1400 -- Transformation Rules
1401
1402 rules   :: { OrdList (LRuleDecl RdrName) }
1403         :  rules ';' rule              {% addAnnotation (oll $1) AnnSemi (gl $2)
1404                                           >> return ($1 `snocOL` $3) }
1405         |  rules ';'                   {% addAnnotation (oll $1) AnnSemi (gl $2)
1406                                           >> return $1 }
1407         |  rule                        { unitOL $1 }
1408         |  {- empty -}                 { nilOL }
1409
1410 rule    :: { LRuleDecl RdrName }
1411         : STRING rule_activation rule_forall infixexp '=' exp
1412          {%ams (sLL $1 $> $ (HsRule (L (gl $1) (getSTRINGs $1,getSTRING $1))
1413                                   ((snd $2) `orElse` AlwaysActive)
1414                                   (snd $3) $4 placeHolderNames $6
1415                                   placeHolderNames))
1416                (mj AnnEqual $5 : (fst $2) ++ (fst $3)) }
1417
1418 -- Rules can be specified to be NeverActive, unlike inline/specialize pragmas
1419 rule_activation :: { ([AddAnn],Maybe Activation) }
1420         : {- empty -}                           { ([],Nothing) }
1421         | rule_explicit_activation              { (fst $1,Just (snd $1)) }
1422
1423 rule_explicit_activation :: { ([AddAnn]
1424                               ,Activation) }  -- In brackets
1425         : '[' INTEGER ']'       { ([mos $1,mj AnnVal $2,mcs $3]
1426                                   ,ActiveAfter  (fromInteger (getINTEGER $2))) }
1427         | '[' '~' INTEGER ']'   { ([mos $1,mj AnnTilde $2,mj AnnVal $3,mcs $4]
1428                                   ,ActiveBefore (fromInteger (getINTEGER $3))) }
1429         | '[' '~' ']'           { ([mos $1,mj AnnTilde $2,mcs $3]
1430                                   ,NeverActive) }
1431
1432 rule_forall :: { ([AddAnn],[LRuleBndr RdrName]) }
1433         : 'forall' rule_var_list '.'     { ([mj AnnForall $1,mj AnnDot $3],$2) }
1434         | {- empty -}                    { ([],[]) }
1435
1436 rule_var_list :: { [LRuleBndr RdrName] }
1437         : rule_var                              { [$1] }
1438         | rule_var rule_var_list                { $1 : $2 }
1439
1440 rule_var :: { LRuleBndr RdrName }
1441         : varid                         { sLL $1 $> (RuleBndr $1) }
1442         | '(' varid '::' ctype ')'      {% ams (sLL $1 $> (RuleBndrSig $2
1443                                                        (mkHsWithBndrs $4)))
1444                                                [mop $1,mj AnnDcolon $3,mcp $5] }
1445
1446 -----------------------------------------------------------------------------
1447 -- Warnings and deprecations (c.f. rules)
1448
1449 warnings :: { OrdList (LWarnDecl RdrName) }
1450         : warnings ';' warning         {% addAnnotation (oll $1) AnnSemi (gl $2)
1451                                           >> return ($1 `appOL` $3) }
1452         | warnings ';'                 {% addAnnotation (oll $1) AnnSemi (gl $2)
1453                                           >> return $1 }
1454         | warning                      { $1 }
1455         | {- empty -}                  { nilOL }
1456
1457 -- SUP: TEMPORARY HACK, not checking for `module Foo'
1458 warning :: { OrdList (LWarnDecl RdrName) }
1459         : namelist strings
1460                 {% amsu (sLL $1 $> (Warning (unLoc $1) (WarningTxt (noLoc "") $ snd $ unLoc $2)))
1461                      (fst $ unLoc $2) }
1462
1463 deprecations :: { OrdList (LWarnDecl RdrName) }
1464         : deprecations ';' deprecation
1465                                        {% addAnnotation (oll $1) AnnSemi (gl $2)
1466                                           >> return ($1 `appOL` $3) }
1467         | deprecations ';'             {% addAnnotation (oll $1) AnnSemi (gl $2)
1468                                           >> return $1 }
1469         | deprecation                  { $1 }
1470         | {- empty -}                  { nilOL }
1471
1472 -- SUP: TEMPORARY HACK, not checking for `module Foo'
1473 deprecation :: { OrdList (LWarnDecl RdrName) }
1474         : namelist strings
1475              {% amsu (sLL $1 $> $ (Warning (unLoc $1) (DeprecatedTxt (noLoc "") $ snd $ unLoc $2)))
1476                      (fst $ unLoc $2) }
1477
1478 strings :: { Located ([AddAnn],[Located (SourceText,FastString)]) }
1479     : STRING { sL1 $1 ([],[L (gl $1) (getSTRINGs $1,getSTRING $1)]) }
1480     | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) }
1481
1482 stringlist :: { Located (OrdList (Located (SourceText,FastString))) }
1483     : stringlist ',' STRING {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
1484                                return (sLL $1 $> (unLoc $1 `snocOL`
1485                                                   (L (gl $3) (getSTRINGs $3,getSTRING $3)))) }
1486     | STRING                { sLL $1 $> (unitOL (L (gl $1) (getSTRINGs $1,getSTRING $1))) }
1487
1488 -----------------------------------------------------------------------------
1489 -- Annotations
1490 annotation :: { LHsDecl RdrName }
1491     : '{-# ANN' name_var aexp '#-}'      {% ams (sLL $1 $> (AnnD $ HsAnnotation
1492                                             (getANN_PRAGs $1)
1493                                             (ValueAnnProvenance $2) $3))
1494                                             [mo $1,mc $4] }
1495
1496     | '{-# ANN' 'type' tycon aexp '#-}'  {% ams (sLL $1 $> (AnnD $ HsAnnotation
1497                                             (getANN_PRAGs $1)
1498                                             (TypeAnnProvenance $3) $4))
1499                                             [mo $1,mj AnnType $2,mc $5] }
1500
1501     | '{-# ANN' 'module' aexp '#-}'      {% ams (sLL $1 $> (AnnD $ HsAnnotation
1502                                                 (getANN_PRAGs $1)
1503                                                  ModuleAnnProvenance $3))
1504                                                 [mo $1,mj AnnModule $2,mc $4] }
1505
1506
1507 -----------------------------------------------------------------------------
1508 -- Foreign import and export declarations
1509
1510 fdecl :: { Located ([AddAnn],HsDecl RdrName) }
1511 fdecl : 'import' callconv safety fspec
1512                {% mkImport $2 $3 (snd $ unLoc $4) >>= \i ->
1513                  return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i))  }
1514       | 'import' callconv        fspec
1515                {% do { d <- mkImport $2 (noLoc PlaySafe) (snd $ unLoc $3);
1516                     return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $3),d)) }}
1517       | 'export' callconv fspec
1518                {% mkExport $2 (snd $ unLoc $3) >>= \i ->
1519                   return (sLL $1 $> (mj AnnExport $1 : (fst $ unLoc $3),i) ) }
1520
1521 callconv :: { Located CCallConv }
1522           : 'stdcall'                   { sLL $1 $> StdCallConv }
1523           | 'ccall'                     { sLL $1 $> CCallConv   }
1524           | 'capi'                      { sLL $1 $> CApiConv    }
1525           | 'prim'                      { sLL $1 $> PrimCallConv}
1526           | 'javascript'                { sLL $1 $> JavaScriptCallConv }
1527
1528 safety :: { Located Safety }
1529         : 'unsafe'                      { sLL $1 $> PlayRisky }
1530         | 'safe'                        { sLL $1 $> PlaySafe }
1531         | 'interruptible'               { sLL $1 $> PlayInterruptible }
1532
1533 fspec :: { Located ([AddAnn]
1534                     ,(Located (SourceText,FastString), Located RdrName, LHsType RdrName)) }
1535        : STRING var '::' sigtypedoc     { sLL $1 $> ([mj AnnDcolon $3]
1536                                              ,(L (getLoc $1)
1537                                                     (getSTRINGs $1,getSTRING $1), $2, $4)) }
1538        |        var '::' sigtypedoc     { sLL $1 $> ([mj AnnDcolon $2]
1539                                              ,(noLoc ("",nilFS), $1, $3)) }
1540          -- if the entity string is missing, it defaults to the empty string;
1541          -- the meaning of an empty entity string depends on the calling
1542          -- convention
1543
1544 -----------------------------------------------------------------------------
1545 -- Type signatures
1546
1547 opt_sig :: { ([AddAnn],Maybe (LHsType RdrName)) }
1548         : {- empty -}                   { ([],Nothing) }
1549         | '::' sigtype                  { ([mj AnnDcolon $1],Just $2) }
1550
1551 opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) }
1552         : {- empty -}                   { ([],Nothing) }
1553         | '::' atype                    { ([mj AnnDcolon $1],Just $2) }
1554
1555 sigtype :: { LHsType RdrName }          -- Always a HsForAllTy,
1556                                         -- to tell the renamer where to generalise
1557         : ctype                         { sL1 $1 (mkImplicitHsForAllTy $1) }
1558         -- Wrap an Implicit forall if there isn't one there already
1559
1560 sigtypedoc :: { LHsType RdrName }       -- Always a HsForAllTy
1561         : ctypedoc                      { sL1 $1 (mkImplicitHsForAllTy $1) }
1562         -- Wrap an Implicit forall if there isn't one there already
1563
1564 sig_vars :: { Located [Located RdrName] }    -- Returned in reversed order
1565          : sig_vars ',' var           {% addAnnotation (gl $ head $ unLoc $1)
1566                                                        AnnComma (gl $2)
1567                                          >> return (sLL $1 $> ($3 : unLoc $1)) }
1568          | var                        { sL1 $1 [$1] }
1569
1570 sigtypes1 :: { (OrdList (LHsType RdrName)) }      -- Always HsForAllTys
1571         : sigtype                      { unitOL $1 }
1572         | sigtype ',' sigtypes1        {% addAnnotation (gl $1) AnnComma (gl $2)
1573                                           >> return ((unitOL $1) `appOL` $3) }
1574
1575 -----------------------------------------------------------------------------
1576 -- Types
1577
1578 strict_mark :: { Located ([AddAnn],HsBang) }
1579         : '!'                        { sL1 $1 ([mj AnnBang $1]
1580                                               ,HsSrcBang Nothing                       Nothing      True) }
1581         | '{-# UNPACK' '#-}'         { sLL $1 $> ([mo $1,mc $2]
1582                                               ,HsSrcBang (Just $ getUNPACK_PRAGs $1)   (Just True)  False) }
1583         | '{-# NOUNPACK' '#-}'       { sLL $1 $> ([mo $1,mc $2]
1584                                               ,HsSrcBang (Just $ getNOUNPACK_PRAGs $1) (Just False) False) }
1585         | '{-# UNPACK' '#-}' '!'     { sLL $1 $> ([mo $1,mc $2,mj AnnBang $3]
1586                                               ,HsSrcBang (Just $ getUNPACK_PRAGs $1)   (Just True)  True) }
1587         | '{-# NOUNPACK' '#-}' '!'   { sLL $1 $> ([mo $1,mc $2,mj AnnBang $3]
1588                                               ,HsSrcBang (Just $ getNOUNPACK_PRAGs $1) (Just False) True) }
1589         -- Although UNPACK with no '!' is illegal, we get a
1590         -- better error message if we parse it here
1591
1592 -- A ctype is a for-all type
1593 ctype   :: { LHsType RdrName }
1594         : 'forall' tv_bndrs '.' ctype   {% hintExplicitForall (getLoc $1) >>
1595                                            ams (sLL $1 $> $ mkExplicitHsForAllTy $2
1596                                                                  (noLoc []) $4)
1597                                                [mj AnnForall $1,mj AnnDot $3] }
1598         | context '=>' ctype          {% addAnnotation (gl $1) AnnDarrow (gl $2)
1599                                          >> return (sLL $1 $> $
1600                                                mkQualifiedHsForAllTy $1 $3) }
1601         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
1602                                              [mj AnnVal $1,mj AnnDcolon $2] }
1603         | type                        { $1 }
1604
1605 ----------------------
1606 -- Notes for 'ctypedoc'
1607 -- It would have been nice to simplify the grammar by unifying `ctype` and
1608 -- ctypedoc` into one production, allowing comments on types everywhere (and
1609 -- rejecting them after parsing, where necessary).  This is however not possible
1610 -- since it leads to ambiguity. The reason is the support for comments on record
1611 -- fields:
1612 --         data R = R { field :: Int -- ^ comment on the field }
1613 -- If we allow comments on types here, it's not clear if the comment applies
1614 -- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
1615
1616 ctypedoc :: { LHsType RdrName }
1617         : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
1618                                             ams (sLL $1 $> $ mkExplicitHsForAllTy $2
1619                                                                   (noLoc []) $4)
1620                                                 [mj AnnForall $1,mj AnnDot $3] }
1621         | context '=>' ctypedoc       {% addAnnotation (gl $1) AnnDarrow (gl $2)
1622                                          >> return (sLL $1 $> $
1623                                                   mkQualifiedHsForAllTy $1 $3) }
1624         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
1625                                              [mj AnnVal $1,mj AnnDcolon $2] }
1626         | typedoc                     { $1 }
1627
1628 ----------------------
1629 -- Notes for 'context'
1630 -- We parse a context as a btype so that we don't get reduce/reduce
1631 -- errors in ctype.  The basic problem is that
1632 --      (Eq a, Ord a)
1633 -- looks so much like a tuple type.  We can't tell until we find the =>
1634
1635 -- We have the t1 ~ t2 form both in 'context' and in type,
1636 -- to permit an individual equational constraint without parenthesis.
1637 -- Thus for some reason we allow    f :: a~b => blah
1638 -- but not                          f :: ?x::Int => blah
1639 context :: { LHsContext RdrName }
1640         : btype '~'      btype          {% do { (anns,ctx) <- checkContext
1641                                                  (sLL $1 $> $ HsEqTy $1 $3)
1642                                               ; ams ctx (mj AnnTilde $2:anns) } }
1643         | btype                         {% do { (anns,ctx) <- checkContext $1
1644                                               ; if null (unLoc ctx)
1645                                                  then addAnnotation (gl $1) AnnUnit (gl $1)
1646                                                  else return ()
1647                                               ; ams ctx anns
1648                                               } }
1649
1650 type :: { LHsType RdrName }
1651         : btype                         { $1 }
1652         | btype qtyconop type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1653         | btype tyvarop  type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1654         | btype '->'     ctype          {% ams $1 [mj AnnRarrow $2]
1655                                         >> ams (sLL $1 $> $ HsFunTy $1 $3)
1656                                                [mj AnnRarrow $2] }
1657         | btype '~'      btype          {% ams (sLL $1 $> $ HsEqTy $1 $3)
1658                                                [mj AnnTilde $2] }
1659                                         -- see Note [Promotion]
1660         | btype SIMPLEQUOTE qconop type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1661                                                 [mj AnnSimpleQuote $2] }
1662         | btype SIMPLEQUOTE varop  type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1663                                                 [mj AnnSimpleQuote $2] }
1664
1665 typedoc :: { LHsType RdrName }
1666         : btype                          { $1 }
1667         | btype docprev                  { sLL $1 $> $ HsDocTy $1 $2 }
1668         | btype qtyconop type            { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1669         | btype qtyconop type docprev    { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
1670         | btype tyvarop  type            { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1671         | btype tyvarop  type docprev    { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
1672         | btype '->'     ctypedoc        {% ams (sLL $1 $> $ HsFunTy $1 $3)
1673                                                 [mj AnnRarrow $2] }
1674         | btype docprev '->' ctypedoc    {% ams (sLL $1 $> $ HsFunTy (L (comb2 $1 $2)
1675                                                             (HsDocTy $1 $2)) $4)
1676                                                 [mj AnnRarrow $3] }
1677         | btype '~'      btype           {% ams (sLL $1 $> $ HsEqTy $1 $3)
1678                                                 [mj AnnTilde $2] }
1679                                         -- see Note [Promotion]
1680         | btype SIMPLEQUOTE qconop type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1681                                                 [mj AnnSimpleQuote $2] }
1682         | btype SIMPLEQUOTE varop  type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1683                                                 [mj AnnSimpleQuote $2] }
1684
1685 btype :: { LHsType RdrName }
1686         : btype atype                   { sLL $1 $> $ HsAppTy $1 $2 }
1687         | atype                         { $1 }
1688
1689 atype :: { LHsType RdrName }
1690         : ntgtycon                       { sL1 $1 (HsTyVar (unLoc $1)) }      -- Not including unit tuples
1691         | tyvar                          {% do { nwc <- namedWildCardsEnabled -- (See Note [Unit tuples])
1692                                                ; let tv@(Unqual name) = unLoc $1
1693                                                ; return $ if (startsWithUnderscore name && nwc)
1694                                                           then (sL1 $1 (mkNamedWildCardTy tv))
1695                                                           else (sL1 $1 (HsTyVar tv)) } }
1696
1697         | strict_mark atype              {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2))
1698                                                 (fst $ unLoc $1) }  -- Constructor sigs only
1699         | '{' fielddecls '}'             {% amms (checkRecordSyntax
1700                                                     (sLL $1 $> $ HsRecTy $2))
1701                                                         -- Constructor sigs only
1702                                                  [moc $1,mcc $3] }
1703         | '(' ')'                        {% ams (sLL $1 $> $ HsTupleTy
1704                                                     HsBoxedOrConstraintTuple [])
1705                                                 [mop $1,mcp $2] }
1706         | '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
1707                                                           (gl $3) >>
1708                                             ams (sLL $1 $> $ HsTupleTy
1709                                              HsBoxedOrConstraintTuple ($2 : $4))
1710                                                 [mop $1,mcp $5] }
1711         | '(#' '#)'                   {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple [])
1712                                              [mo $1,mc $2] }
1713         | '(#' comma_types1 '#)'      {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple $2)
1714                                              [mo $1,mc $3] }
1715         | '[' ctype ']'               {% ams (sLL $1 $> $ HsListTy  $2) [mos $1,mcs $3] }
1716         | '[:' ctype ':]'             {% ams (sLL $1 $> $ HsPArrTy  $2) [mo $1,mc $3] }
1717         | '(' ctype ')'               {% ams (sLL $1 $> $ HsParTy   $2) [mop $1,mcp $3] }
1718         | '(' ctype '::' kind ')'     {% ams (sLL $1 $> $ HsKindSig $2 $4)
1719                                              [mop $1,mj AnnDcolon $3,mcp $5] }
1720         | quasiquote                  { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
1721         | '$(' exp ')'                {% ams (sLL $1 $> $ mkHsSpliceTy $2)
1722                                              [mj AnnOpenPE $1,mj AnnCloseP $3] }
1723         | TH_ID_SPLICE                {%ams (sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $
1724                                              mkUnqual varName (getTH_ID_SPLICE $1))
1725                                              [mj AnnThIdSplice $1] }
1726                                       -- see Note [Promotion] for the followings
1727         | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar $ unLoc $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
1728         | SIMPLEQUOTE  '(' ctype ',' comma_types1 ')'
1729                              {% addAnnotation (gl $3) AnnComma (gl $4) >>
1730                                 ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5))
1731                                     [mj AnnSimpleQuote $1,mop $2,mcp $6] }
1732         | SIMPLEQUOTE  '[' comma_types0 ']'     {% ams (sLL $1 $> $ HsExplicitListTy
1733                                                             placeHolderKind $3)
1734                                                        [mj AnnSimpleQuote $1,mos $2,mcs $4] }
1735         | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar $ unLoc $2)
1736                                                        [mj AnnSimpleQuote $1,mj AnnName $2] }
1737
1738         -- Two or more [ty, ty, ty] must be a promoted list type, just as
1739         -- if you had written '[ty, ty, ty]
1740         -- (One means a list type, zero means the list type constructor,
1741         -- so you have to quote those.)
1742         | '[' ctype ',' comma_types1 ']'  {% addAnnotation (gl $2) AnnComma
1743                                                            (gl $3) >>
1744                                              ams (sLL $1 $> $ HsExplicitListTy
1745                                                      placeHolderKind ($2 : $4))
1746                                                  [mos $1,mcs $5] }
1747         | INTEGER              { sLL $1 $> $ HsTyLit $ HsNumTy (getINTEGERs $1)
1748                                                                (getINTEGER $1) }
1749         | STRING               { sLL $1 $> $ HsTyLit $ HsStrTy (getSTRINGs $1)
1750                                                                (getSTRING  $1) }
1751         | '_'                  { sL1 $1 $ mkAnonWildCardTy }
1752
1753 -- An inst_type is what occurs in the head of an instance decl
1754 --      e.g.  (Foo a, Gaz b) => Wibble a b
1755 -- It's kept as a single type, with a MonoDictTy at the right
1756 -- hand corner, for convenience.
1757 inst_type :: { LHsType RdrName }
1758         : sigtype                       { $1 }
1759
1760 inst_types1 :: { [LHsType RdrName] }
1761         : inst_type                     { [$1] }
1762
1763         | inst_type ',' inst_types1    {% addAnnotation (gl $1) AnnComma (gl $2)
1764                                           >> return ($1 : $3) }
1765
1766 comma_types0  :: { [LHsType RdrName] }  -- Zero or more:  ty,ty,ty
1767         : comma_types1                  { $1 }
1768         | {- empty -}                   { [] }
1769
1770 comma_types1    :: { [LHsType RdrName] }  -- One or more:  ty,ty,ty
1771         : ctype                        { [$1] }
1772         | ctype  ',' comma_types1      {% addAnnotation (gl $1) AnnComma (gl $2)
1773                                           >> return ($1 : $3) }
1774
1775 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1776          : tv_bndr tv_bndrs             { $1 : $2 }
1777          | {- empty -}                  { [] }
1778
1779 tv_bndr :: { LHsTyVarBndr RdrName }
1780         : tyvar                         { sL1 $1 (UserTyVar (unLoc $1)) }
1781         | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar $2 $4))
1782                                                [mop $1,mj AnnDcolon $3
1783                                                ,mcp $5] }
1784
1785 fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
1786         : {- empty -}                   { noLoc ([],[]) }
1787         | '|' fds1                      { (sLL $1 $> ([mj AnnVbar $1]
1788                                                  ,reverse (unLoc $2))) }
1789
1790 fds1 :: { Located [Located (FunDep (Located RdrName))] }
1791         : fds1 ',' fd   {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2)
1792                            >> return (sLL $1 $> ($3 : unLoc $1)) }
1793         | fd            { sL1 $1 [$1] }
1794
1795 fd :: { Located (FunDep (Located RdrName)) }
1796         : varids0 '->' varids0  {% ams (L (comb3 $1 $2 $3)
1797                                        (reverse (unLoc $1), reverse (unLoc $3)))
1798                                        [mj AnnRarrow $2] }
1799
1800 varids0 :: { Located [Located RdrName] }
1801         : {- empty -}                   { noLoc [] }
1802         | varids0 tyvar                 { sLL $1 $> ($2 : unLoc $1) }
1803
1804 -----------------------------------------------------------------------------
1805 -- Kinds
1806
1807 kind :: { LHsKind RdrName }
1808         : bkind                  { $1 }
1809         | bkind '->' kind        {% ams (sLL $1 $> $ HsFunTy $1 $3)
1810                                         [mj AnnRarrow $2] }
1811
1812 bkind :: { LHsKind RdrName }
1813         : akind                  { $1 }
1814         | bkind akind            { sLL $1 $> $ HsAppTy $1 $2 }
1815
1816 akind :: { LHsKind RdrName }
1817         : '*'                    { sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName) }
1818         | '(' kind ')'           {% ams (sLL $1 $>  $ HsParTy $2)
1819                                         [mop $1,mcp $3] }
1820         | pkind                  { $1 }
1821         | tyvar                  { sL1 $1 $ HsTyVar (unLoc $1) }
1822
1823 pkind :: { LHsKind RdrName }  -- promoted type, see Note [Promotion]
1824         : qtycon                          { sL1 $1 $ HsTyVar $ unLoc $1 }
1825         | '(' ')'                   {% ams (sLL $1 $> $ HsTyVar $ getRdrName unitTyCon)
1826                                            [mop $1,mcp $2] }
1827         | '(' kind ',' comma_kinds1 ')'
1828                           {% addAnnotation (gl $2) AnnComma (gl $3) >>
1829                              ams (sLL $1 $> $ HsTupleTy HsBoxedTuple ( $2 : $4))
1830                                  [mop $1,mcp $5] }
1831         | '[' kind ']'                    {% ams (sLL $1 $> $ HsListTy $2)
1832                                                  [mos $1,mcs $3] }
1833
1834 comma_kinds1 :: { [LHsKind RdrName] }
1835         : kind                         { [$1] }
1836         | kind  ',' comma_kinds1       {% addAnnotation (gl $1) AnnComma (gl $2)
1837                                           >> return ($1 : $3) }
1838
1839 {- Note [Promotion]
1840    ~~~~~~~~~~~~~~~~
1841
1842 - Syntax of promoted qualified names
1843 We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
1844 names. Moreover ticks are only allowed in types, not in kinds, for a
1845 few reasons:
1846   1. we don't need quotes since we cannot define names in kinds
1847   2. if one day we merge types and kinds, tick would mean look in DataName
1848   3. we don't have a kind namespace anyway
1849
1850 - Syntax of explicit kind polymorphism  (IA0_TODO: not yet implemented)
1851 Kind abstraction is implicit. We write
1852 > data SList (s :: k -> *) (as :: [k]) where ...
1853 because it looks like what we do in terms
1854 > id (x :: a) = x
1855
1856 - Name resolution
1857 When the user write Zero instead of 'Zero in types, we parse it a
1858 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
1859 deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
1860 bounded in the type level, then we look for it in the term level (we
1861 change its namespace to DataName, see Note [Demotion] in OccName). And
1862 both become a HsTyVar ("Zero", DataName) after the renamer.
1863
1864 -}
1865
1866
1867 -----------------------------------------------------------------------------
1868 -- Datatype declarations
1869
1870 gadt_constrlist :: { Located ([AddAnn]
1871                           ,[LConDecl RdrName]) } -- Returned in order
1872         : 'where' '{'        gadt_constrs '}'   { L (comb2 $1 $3)
1873                                                     ([mj AnnWhere $1
1874                                                      ,moc $2
1875                                                      ,mcc $4]
1876                                                     , unLoc $3) }
1877         | 'where' vocurly    gadt_constrs close  { L (comb2 $1 $3)
1878                                                      ([mj AnnWhere $1]
1879                                                      , unLoc $3) }
1880         | {- empty -}                            { noLoc ([],[]) }
1881
1882 gadt_constrs :: { Located [LConDecl RdrName] }
1883         : gadt_constr ';' gadt_constrs
1884                   {% addAnnotation (gl $1) AnnSemi (gl $2)
1885                      >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
1886         | gadt_constr                   { L (gl $1) [$1] }
1887         | {- empty -}                   { noLoc [] }
1888
1889 -- We allow the following forms:
1890 --      C :: Eq a => a -> T a
1891 --      C :: forall a. Eq a => !a -> T a
1892 --      D { x,y :: a } :: T a
1893 --      forall a. Eq a => D { x,y :: a } :: T a
1894
1895 gadt_constr :: { LConDecl RdrName }
1896                    -- Returns a list because of:   C,D :: ty
1897         : con_list '::' sigtype
1898                 {% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3
1899                       ; ams (sLL $1 $> $ gadtDecl)
1900                             (mj AnnDcolon $2:anns) } }
1901
1902                 -- Deprecated syntax for GADT record declarations
1903         | oqtycon '{' fielddecls '}' '::' sigtype
1904                 {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 (noLoc $3) $6
1905                       ; cd' <- checkRecordSyntax cd
1906                       ; ams (L (comb2 $1 $6) (unLoc cd'))
1907                             [moc $2,mcc $4,mj AnnDcolon $5] } }
1908
1909 constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
1910         : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
1911                                                      ,addConDocs (unLoc $3) $1)}
1912
1913 constrs1 :: { Located [LConDecl RdrName] }
1914         : constrs1 maybe_docnext '|' maybe_docprev constr
1915             {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
1916                >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
1917         | constr                                          { sL1 $1 [$1] }
1918
1919 constr :: { LConDecl RdrName }
1920         : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1921                 {% ams (let (con,details) = unLoc $5 in
1922                   addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con
1923                                                    (snd $ unLoc $2) $3 details))
1924                             ($1 `mplus` $6))
1925                         (mj AnnDarrow $4:(fst $ unLoc $2)) }
1926         | maybe_docnext forall constr_stuff maybe_docprev
1927                 {% ams ( let (con,details) = unLoc $3 in
1928                   addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con
1929                                            (snd $ unLoc $2) (noLoc []) details))
1930                             ($1 `mplus` $4))
1931                        (fst $ unLoc $2) }
1932
1933 forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) }
1934         : 'forall' tv_bndrs '.'       { sLL $1 $> ([mj AnnForall $1,mj AnnDot $3],$2) }
1935         | {- empty -}                 { noLoc ([],[]) }
1936
1937 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1938 -- We parse the constructor declaration
1939 --      C t1 t2
1940 -- as a btype (treating C as a type constructor) and then convert C to be
1941 -- a data constructor.  Reason: it might continue like this:
1942 --      C t1 t2 %: D Int
1943 -- in which case C really would be a type constructor.  We can't resolve this
1944 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
1945         : btype                         {% splitCon $1 >>= return.sLL $1 $> }
1946         | btype conop btype             {  sLL $1 $> ($2, InfixCon $1 $3) }
1947
1948 fielddecls :: { [LConDeclField RdrName] }
1949         : {- empty -}     { [] }
1950         | fielddecls1     { $1 }
1951
1952 fielddecls1 :: { [LConDeclField RdrName] }
1953         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
1954             {% addAnnotation (gl $1) AnnComma (gl $3) >>
1955                return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
1956         | fielddecl   { [$1] }
1957
1958 fielddecl :: { LConDeclField RdrName }
1959                                               -- A list because of   f,g :: Int
1960         : maybe_docnext sig_vars '::' ctype maybe_docprev
1961             {% ams (L (comb2 $2 $4)
1962                       (ConDeclField (reverse (unLoc $2)) $4 ($1 `mplus` $5)))
1963                    [mj AnnDcolon $3] }
1964
1965 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1966 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1967 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1968 -- We don't allow a context, but that's sorted out by the type checker.
1969 deriving :: { Located (Maybe (Located [LHsType RdrName])) }
1970         : {- empty -}             { noLoc Nothing }
1971         | 'deriving' qtycon       {% aljs ( let { L loc tv = $2 }
1972                                             in (sLL $1 $> (Just (sLL $1 $>
1973                                                        [L loc (HsTyVar tv)]))))
1974                                           [mj AnnDeriving $1] }
1975         | 'deriving' '(' ')'      {% aljs (sLL $1 $> (Just (sLL $1 $> [])))
1976                                           [mj AnnDeriving $1,mop $2,mcp $3] }
1977
1978         | 'deriving' '(' inst_types1 ')'  {% aljs (sLL $1 $> (Just (sLL $1 $> $3)))
1979                                                  [mj AnnDeriving $1,mop $2,mcp $4] }
1980              -- Glasgow extension: allow partial
1981              -- applications in derivings
1982
1983 -----------------------------------------------------------------------------
1984 -- Value definitions
1985
1986 {- Note [Declaration/signature overlap]
1987 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1988 There's an awkward overlap with a type signature.  Consider
1989         f :: Int -> Int = ...rhs...
1990    Then we can't tell whether it's a type signature or a value
1991    definition with a result signature until we see the '='.
1992    So we have to inline enough to postpone reductions until we know.
1993 -}
1994
1995 {-
1996   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1997   instead of qvar, we get another shift/reduce-conflict. Consider the
1998   following programs:
1999
2000      { (^^) :: Int->Int ; }          Type signature; only var allowed
2001
2002      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
2003                                      qvar allowed (because of instance decls)
2004
2005   We can't tell whether to reduce var to qvar until after we've read the signatures.
2006 -}
2007
2008 docdecl :: { LHsDecl RdrName }
2009         : docdecld { sL1 $1 (DocD (unLoc $1)) }
2010
2011 docdecld :: { LDocDecl }
2012         : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
2013         | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
2014         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
2015         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
2016
2017 decl_no_th :: { LHsDecl RdrName }
2018         : sigdecl               { $1 }
2019
2020         | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) };
2021                                         pat <- checkPattern empty e;
2022                                         _ <- ams (sLL $1 $> ())
2023                                                (fst $ unLoc $3);
2024                                         return $ sLL $1 $> $ ValD $
2025                                             PatBind pat (snd $ unLoc $3)
2026                                                     placeHolderType
2027                                                     placeHolderNames
2028                                                     ([],[]) } }
2029                                 -- Turn it all into an expression so that
2030                                 -- checkPattern can check that bangs are enabled
2031
2032         | infixexp opt_sig rhs  {% do { (ann,r) <- checkValDef empty $1 (snd $2) $3;
2033                                         let { l = comb2 $1 $> };
2034                                         case r of {
2035                                           (FunBind n _ _ _ _ _) ->
2036                                                 ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
2037                                           (PatBind (L lh _lhs) _rhs _ _ _) ->
2038                                                 ams (L lh ()) (fst $2) >> return () } ;
2039                                         _ <- ams (L l ()) (ann ++ (fst $ unLoc $3));
2040                                         return $! (sL l $ ValD r) } }
2041         | pattern_synonym_decl  { $1 }
2042         | docdecl               { $1 }
2043
2044 decl    :: { LHsDecl RdrName }
2045         : decl_no_th            { $1 }
2046
2047         -- Why do we only allow naked declaration splices in top-level
2048         -- declarations and not here? Short answer: because readFail009
2049         -- fails terribly with a panic in cvBindsAndSigs otherwise.
2050         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
2051
2052 rhs     :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2053         : '=' exp wherebinds    { sL (comb3 $1 $2 $3)
2054                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
2055                                     ,GRHSs (unguardedRHS (comb3 $1 $2 $3) $2)
2056                                    (snd $ unLoc $3)) }
2057         | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
2058                                     ,GRHSs (reverse (unLoc $1))
2059                                                     (snd $ unLoc $2)) }
2060
2061 gdrhs :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2062         : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
2063         | gdrh                  { sL1 $1 [$1] }
2064
2065 gdrh :: { LGRHS RdrName (LHsExpr RdrName) }
2066         : '|' guardquals '=' exp  {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2067                                          [mj AnnVbar $1,mj AnnEqual $3] }
2068
2069 sigdecl :: { LHsDecl RdrName }
2070         :
2071         -- See Note [Declaration/signature overlap] for why we need infixexp here
2072           infixexp '::' sigtypedoc
2073                         {% do s <- checkValSig $1 $3
2074                         ; _ <- ams (sLL $1 $> ()) [mj AnnDcolon $2]
2075                         ; return (sLL $1 $> $ SigD s) }
2076
2077         | var ',' sig_vars '::' sigtypedoc
2078            {% do { let sig = TypeSig ($1 : reverse (unLoc $3)) $5 PlaceHolder
2079                  ; addAnnotation (gl $1) AnnComma (gl $2)
2080                  ; ams ( sLL $1 $> $ SigD sig )
2081                        [mj AnnDcolon $4] } }
2082
2083         | infix prec ops
2084               {% ams (sLL $1 $> $ SigD
2085                         (FixSig (FixitySig (fromOL $ unLoc $3)
2086                                 (Fixity (unLoc $2) (unLoc $1)))))
2087                      [mj AnnInfix $1,mj AnnVal $2] }
2088
2089         | pattern_synonym_sig   { sLL $1 $> . SigD . unLoc $ $1 }
2090
2091         | '{-# INLINE' activation qvar '#-}'
2092                 {% ams ((sLL $1 $> $ SigD (InlineSig $3
2093                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
2094                                             (snd $2)))))
2095                        ((mo $1:fst $2) ++ [mc $4]) }
2096
2097         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
2098              {% ams (
2099                  let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
2100                                              (EmptyInlineSpec, FunLike) (snd $2)
2101                   in sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag))
2102                     (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
2103
2104         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
2105              {% ams (sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
2106                                (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
2107                                                (getSPEC_INLINE $1) (snd $2))))
2108                        (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
2109
2110         | '{-# SPECIALISE' 'instance' inst_type '#-}'
2111                 {% ams (sLL $1 $>
2112                                   $ SigD (SpecInstSig (getSPEC_PRAGs $1) $3))
2113                        [mo $1,mj AnnInstance $2,mc $4] }
2114
2115         -- AZ TODO: Do we need locations in the name_formula_opt?
2116         -- A minimal complete definition
2117         | '{-# MINIMAL' name_boolformula_opt '#-}'
2118             {% ams (sLL $1 $> $ SigD (MinimalSig (getMINIMAL_PRAGs $1) (snd $2)))
2119                    (mo $1:mc $3:fst $2) }
2120
2121 activation :: { ([AddAnn],Maybe Activation) }
2122         : {- empty -}                           { ([],Nothing) }
2123         | explicit_activation                   { (fst $1,Just (snd $1)) }
2124
2125 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
2126         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
2127                                   ,ActiveAfter  (fromInteger (getINTEGER $2))) }
2128         | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
2129                                                  ,mj AnnCloseS $4]
2130                                   ,ActiveBefore (fromInteger (getINTEGER $3))) }
2131
2132 -----------------------------------------------------------------------------
2133 -- Expressions
2134
2135 quasiquote :: { Located (HsSplice RdrName) }
2136         : TH_QUASIQUOTE   { let { loc = getLoc $1
2137                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
2138                                 ; quoterId = mkUnqual varName quoter }
2139                             in sL1 $1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2140         | TH_QQUASIQUOTE  { let { loc = getLoc $1
2141                                 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
2142                                 ; quoterId = mkQual varName (qual, quoter) }
2143                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2144
2145 exp   :: { LHsExpr RdrName }
2146         : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 $3 PlaceHolder)
2147                                        [mj AnnDcolon $2] }
2148         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2149                                                         HsFirstOrderApp True)
2150                                        [mj Annlarrowtail $2] }
2151         | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2152                                                       HsFirstOrderApp False)
2153                                        [mj Annrarrowtail $2] }
2154         | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2155                                                       HsHigherOrderApp True)
2156                                        [mj AnnLarrowtail $2] }
2157         | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2158                                                       HsHigherOrderApp False)
2159                                        [mj AnnRarrowtail $2] }
2160         | infixexp              { $1 }
2161
2162 infixexp :: { LHsExpr RdrName }
2163         : exp10                   { $1 }
2164         | infixexp qop exp10      {% ams (sLL $1 $>
2165                                              (OpApp $1 $2 placeHolderFixity $3))
2166                                          [mj AnnVal $2] }
2167                  -- AnnVal annotation for NPlusKPat, which discards the operator
2168
2169
2170 exp10 :: { LHsExpr RdrName }
2171         : '\\' apat apats opt_asig '->' exp
2172                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
2173                             [sLL $1 $> $ Match Nothing ($2:$3) (snd $4) (unguardedGRHSs $6)]))
2174                           (mj AnnLam $1:mj AnnRarrow $5:(fst $4)) }
2175         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
2176                                                (mj AnnLet $1:mj AnnIn $3
2177                                                  :(fst $ unLoc $2)) }
2178         | '\\' 'lcase' altslist
2179             {% ams (sLL $1 $> $ HsLamCase placeHolderType
2180                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
2181                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
2182         | 'if' exp optSemi 'then' exp optSemi 'else' exp
2183                            {% checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
2184                               ams (sLL $1 $> $ mkHsIf $2 $5 $8)
2185                                   (mj AnnIf $1:mj AnnThen $4
2186                                      :mj AnnElse $7
2187                                      :(map (\l -> mj AnnSemi l) (fst $3))
2188                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
2189         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
2190                                            ams (sLL $1 $> $ HsMultiIf
2191                                                      placeHolderType
2192                                                      (reverse $ snd $ unLoc $2))
2193                                                (mj AnnIf $1:(fst $ unLoc $2)) }
2194         | 'case' exp 'of' altslist      {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
2195                                                    FromSource (snd $ unLoc $4)))
2196                                                (mj AnnCase $1:mj AnnOf $3
2197                                                   :(fst $ unLoc $4)) }
2198         | '-' fexp                      {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
2199                                                [mj AnnMinus $1] }
2200
2201         | 'do' stmtlist              {% ams (L (comb2 $1 $2)
2202                                                (mkHsDo DoExpr (snd $ unLoc $2)))
2203                                                (mj AnnDo $1:(fst $ unLoc $2)) }
2204         | 'mdo' stmtlist            {% ams (L (comb2 $1 $2)
2205                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
2206                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
2207
2208         | scc_annot exp        {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2209                                       (fst $ fst $ unLoc $1) }
2210
2211         | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2212                                       (fst $ fst $ unLoc $1) }
2213
2214         | 'proc' aexp '->' exp
2215                        {% checkPattern empty $2 >>= \ p ->
2216                            checkCommand $4 >>= \ cmd ->
2217                            ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
2218                                                 placeHolderType []))
2219                                             -- TODO: is LL right here?
2220                                [mj AnnProc $1,mj AnnRarrow $3] }
2221
2222         | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getSTRINGs $2,getSTRING $2) $4)
2223                                               [mo $1,mj AnnVal $2
2224                                               ,mc $3] }
2225                                           -- hdaume: core annotation
2226         | fexp                         { $1 }
2227
2228         -- parsing error messages go below here
2229         | '\\' apat apats opt_asig '->' error        {% parseErrorSDoc (combineLocs $1 $5) $ text
2230                                                         "parse error in lambda: no expression after '->'"
2231                                                      }
2232         | '\\' error                                 {% parseErrorSDoc (getLoc $1) $ text
2233                                                         "parse error: naked lambda expression '\'"
2234                                                      }
2235         | 'let' binds 'in' error                     {% parseErrorSDoc (combineLocs $1 $2) $ text
2236                                                         "parse error in let binding: missing expression after 'in'"
2237                                                      }
2238         | 'let' binds error                          {% parseErrorSDoc (combineLocs $1 $2) $ text
2239                                                         "parse error in let binding: missing required 'in'"
2240                                                      }
2241         | 'let' error                                {% parseErrorSDoc (getLoc $1) $ text
2242                                                         "parse error: naked let binding"
2243                                                      }
2244         | 'if' exp optSemi 'then' exp optSemi
2245           'else' error                               {% hintIf (combineLocs $1 $5) "else clause empty" }
2246         | 'if' exp optSemi 'then' exp optSemi error  {% hintIf (combineLocs $1 $5) "missing required else clause" }
2247         | 'if' exp optSemi 'then' error              {% hintIf (combineLocs $1 $2) "then clause empty" }
2248         | 'if' exp optSemi error                     {% hintIf (combineLocs $1 $2) "missing required then and else clauses" }
2249         | 'if' error                                 {% hintIf (getLoc $1) "naked if statement" }
2250         | 'case' exp 'of' error                      {% parseErrorSDoc (combineLocs $1 $2) $ text
2251                                                         "parse error in case statement: missing list after '->'"
2252                                                      }
2253         | 'case' exp error                           {% parseErrorSDoc (combineLocs $1 $2) $ text
2254                                                         "parse error in case statement: missing required 'of'"
2255                                                      }
2256         | 'case' error                               {% parseErrorSDoc (getLoc $1) $ text
2257                                                         "parse error: naked case statement"
2258                                                      }
2259 optSemi :: { ([Located a],Bool) }
2260         : ';'         { ([$1],True) }
2261         | {- empty -} { ([],False) }
2262
2263 scc_annot :: { Located (([AddAnn],SourceText),(SourceText,FastString)) }
2264         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
2265                                             ; return $ sLL $1 $>
2266                                                (([mo $1,mj AnnValStr $2
2267                                                 ,mc $3],getSCC_PRAGs $1),(getSTRINGs $2,scc)) }
2268         | '{-# SCC' VARID  '#-}'      { sLL $1 $> (([mo $1,mj AnnVal $2
2269                                          ,mc $3],getSCC_PRAGs $1)
2270                                         ,(unpackFS $ getVARID $2,getVARID $2)) }
2271
2272 hpc_annot :: { Located (([AddAnn],SourceText),((SourceText,FastString),(Int,Int),(Int,Int))) }
2273       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
2274                                       { sLL $1 $> $ (([mo $1,mj AnnVal $2
2275                                               ,mj AnnVal $3,mj AnnColon $4
2276                                               ,mj AnnVal $5,mj AnnMinus $6
2277                                               ,mj AnnVal $7,mj AnnColon $8
2278                                               ,mj AnnVal $9,mc $10],
2279                                                 getGENERATED_PRAGs $1)
2280                                               ,((getSTRINGs $2,getSTRING $2)
2281                                                ,( fromInteger $ getINTEGER $3
2282                                                 , fromInteger $ getINTEGER $5
2283                                                 )
2284                                                ,( fromInteger $ getINTEGER $7
2285                                                 , fromInteger $ getINTEGER $9
2286                                                 )
2287                                                ))
2288                                          }
2289
2290 fexp    :: { LHsExpr RdrName }
2291         : fexp aexp                             { sLL $1 $> $ HsApp $1 $2 }
2292         | 'static' aexp                         {% ams (sLL $1 $> $ HsStatic $2)
2293                                                        [mj AnnStatic $1] }
2294         | aexp                                  { $1 }
2295
2296 aexp    :: { LHsExpr RdrName }
2297         : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
2298         | '~' aexp              {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
2299         | aexp1                 { $1 }
2300
2301 aexp1   :: { LHsExpr RdrName }
2302         : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
2303                                                                    (snd $3)
2304                                      ; _ <- ams (sLL $1 $> ()) (moc $2:mcc $4:(fst $3))
2305                                      ; checkRecordSyntax (sLL $1 $> r) }}
2306         | aexp2                { $1 }
2307
2308 aexp2   :: { LHsExpr RdrName }
2309         : qvar                          { sL1 $1 (HsVar   $! unLoc $1) }
2310         | qcon                          { sL1 $1 (HsVar   $! unLoc $1) }
2311         | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
2312         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
2313 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
2314 -- into HsOverLit when -foverloaded-strings is on.
2315 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
2316 --                                       (getSTRING $1) placeHolderType) }
2317         | INTEGER   { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGERs $1)
2318                                          (getINTEGER $1) placeHolderType) }
2319         | RATIONAL  { sL (getLoc $1) (HsOverLit $! mkHsFractional
2320                                           (getRATIONAL $1) placeHolderType) }
2321
2322         -- N.B.: sections get parsed by these next two productions.
2323         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
2324         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
2325         -- but the less cluttered version fell out of having texps.
2326         | '(' texp ')'                  {% ams (sLL $1 $> (HsPar $2)) [mop $1,mcp $3] }
2327         | '(' tup_exprs ')'             {% ams (sLL $1 $> (ExplicitTuple $2 Boxed))
2328                                                [mop $1,mcp $3] }
2329
2330         | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple [L (gl $2)
2331                                                          (Present $2)] Unboxed))
2332                                                [mo $1,mc $3] }
2333         | '(#' tup_exprs '#)'           {% ams (sLL $1 $> (ExplicitTuple $2 Unboxed))
2334                                                [mo $1,mc $3] }
2335
2336         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
2337         | '[:' parr ':]'    {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
2338         | '_'               { sL1 $1 EWildPat }
2339
2340         -- Template Haskell Extension
2341         | splice_exp            { $1 }
2342
2343         | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2344         | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2345         | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2346         | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2347         | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] }
2348         | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]}
2349         | '[t|' ctype '|]'    {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
2350         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
2351                                       ams (sLL $1 $> $ HsBracket (PatBr p))
2352                                           [mo $1,mc $3] }
2353         | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
2354                                       (mo $1:mc $3:fst $2) }
2355         | quasiquote          { sL1 $1 (HsSpliceE (unLoc $1)) }
2356
2357         -- arrow notation extension
2358         | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm $2
2359                                                            Nothing (reverse $3))
2360                                           [mo $1,mc $4] }
2361
2362 splice_exp :: { LHsExpr RdrName }
2363         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkHsSpliceE
2364                                         (sL1 $1 $ HsVar (mkUnqual varName
2365                                                         (getTH_ID_SPLICE $1))))
2366                                        [mj AnnThIdSplice $1] }
2367         | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE $2)
2368                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
2369         | TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkHsSpliceTE
2370                                         (sL1 $1 $ HsVar (mkUnqual varName
2371                                                      (getTH_ID_TY_SPLICE $1))))
2372                                        [mj AnnThIdTySplice $1] }
2373         | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE $2)
2374                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
2375
2376 cmdargs :: { [LHsCmdTop RdrName] }
2377         : cmdargs acmd                  { $2 : $1 }
2378         | {- empty -}                   { [] }
2379
2380 acmd    :: { LHsCmdTop RdrName }
2381         : aexp2                 {% checkCommand $1 >>= \ cmd ->
2382                                     return (sL1 $1 $ HsCmdTop cmd
2383                                            placeHolderType placeHolderType []) }
2384
2385 cvtopbody :: { ([AddAnn],[LHsDecl RdrName]) }
2386         :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1
2387                                                   ,mj AnnCloseC $3],$2) }
2388         |      vocurly    cvtopdecls0 close    { ([],$2) }
2389
2390 cvtopdecls0 :: { [LHsDecl RdrName] }
2391         : {- empty -}           { [] }
2392         | cvtopdecls            { $1 }
2393
2394 -----------------------------------------------------------------------------
2395 -- Tuple expressions
2396
2397 -- "texp" is short for tuple expressions:
2398 -- things that can appear unparenthesized as long as they're
2399 -- inside parens or delimitted by commas
2400 texp :: { LHsExpr RdrName }
2401         : exp                           { $1 }
2402
2403         -- Note [Parsing sections]
2404         -- ~~~~~~~~~~~~~~~~~~~~~~~
2405         -- We include left and right sections here, which isn't
2406         -- technically right according to the Haskell standard.
2407         -- For example (3 +, True) isn't legal.
2408         -- However, we want to parse bang patterns like
2409         --      (!x, !y)
2410         -- and it's convenient to do so here as a section
2411         -- Then when converting expr to pattern we unravel it again
2412         -- Meanwhile, the renamer checks that real sections appear
2413         -- inside parens.
2414         | infixexp qop        { sLL $1 $> $ SectionL $1 $2 }
2415         | qopm infixexp       { sLL $1 $> $ SectionR $1 $2 }
2416
2417        -- View patterns get parenthesized above
2418         | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] }
2419
2420 -- Always at least one comma
2421 tup_exprs :: { [LHsTupArg RdrName] }
2422            : texp commas_tup_tail
2423                           {% do { addAnnotation (gl $1) AnnComma (fst $2)
2424                                 ; return ((sL1 $1 (Present $1)) : snd $2) } }
2425
2426            | commas tup_tail
2427                 {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
2428                       ; return
2429                            (map (\l -> L l missingTupArg) (fst $1) ++ $2) } }
2430
2431 -- Always starts with commas; always follows an expr
2432 commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) }
2433 commas_tup_tail : commas tup_tail
2434        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
2435              ; return (
2436             (head $ fst $1
2437             ,(map (\l -> L l missingTupArg) (tail $ fst $1)) ++ $2)) } }
2438
2439 -- Always follows a comma
2440 tup_tail :: { [LHsTupArg RdrName] }
2441           : texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
2442                                     return ((L (gl $1) (Present $1)) : snd $2) }
2443           | texp                 { [L (gl $1) (Present $1)] }
2444           | {- empty -}          { [noLoc missingTupArg] }
2445
2446 -----------------------------------------------------------------------------
2447 -- List expressions
2448
2449 -- The rules below are little bit contorted to keep lexps left-recursive while
2450 -- avoiding another shift/reduce-conflict.
2451 list :: { ([AddAnn],HsExpr RdrName) }
2452         : texp    { ([],ExplicitList placeHolderType Nothing [$1]) }
2453         | lexps   { ([],ExplicitList placeHolderType Nothing
2454                                                    (reverse (unLoc $1))) }
2455         | texp '..'             { ([mj AnnDotdot $2],
2456                                       ArithSeq noPostTcExpr Nothing (From $1)) }
2457         | texp ',' exp '..'     { ([mj AnnComma $2,mj AnnDotdot $4],
2458                                   ArithSeq noPostTcExpr Nothing
2459                                                              (FromThen $1 $3)) }
2460         | texp '..' exp         { ([mj AnnDotdot $2],
2461                                    ArithSeq noPostTcExpr Nothing
2462                                                                (FromTo $1 $3)) }
2463         | texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
2464                                     ArithSeq noPostTcExpr Nothing
2465                                                 (FromThenTo $1 $3 $5)) }
2466         | texp '|' flattenedpquals
2467              {% checkMonadComp >>= \ ctxt ->
2468                 return ([mj AnnVbar $2],
2469                         mkHsComp ctxt (unLoc $3) $1) }
2470
2471 lexps :: { Located [LHsExpr RdrName] }
2472         : lexps ',' texp          {% addAnnotation (gl $ head $ unLoc $1)
2473                                                             AnnComma (gl $2) >>
2474                                       return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
2475         | texp ',' texp            {% addAnnotation (gl $1) AnnComma (gl $2) >>
2476                                       return (sLL $1 $> [$3,$1]) }
2477
2478 -----------------------------------------------------------------------------
2479 -- List Comprehensions
2480
2481 flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2482     : pquals   { case (unLoc $1) of
2483                     [qs] -> sL1 $1 qs
2484                     -- We just had one thing in our "parallel" list so
2485                     -- we simply return that thing directly
2486
2487                     qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock qs [] noSyntaxExpr |
2488                                             qs <- qss]
2489                                             noSyntaxExpr noSyntaxExpr]
2490                     -- We actually found some actual parallel lists so
2491                     -- we wrap them into as a ParStmt
2492                 }
2493
2494 pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] }
2495     : squals '|' pquals
2496                      {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
2497                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
2498     | squals         { L (getLoc $1) [reverse (unLoc $1)] }
2499
2500 squals :: { Located [LStmt RdrName (LHsExpr RdrName)] }   -- In reverse order, because the last
2501                                         -- one can "grab" the earlier ones
2502     : squals ',' transformqual
2503              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2504                 ams (sLL $1 $> ()) (fst $ unLoc $3) >>
2505                 return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
2506     | squals ',' qual
2507              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2508                 return (sLL $1 $> ($3 : unLoc $1)) }
2509     | transformqual        {% ams $1 (fst $ unLoc $1) >>
2510                               return (sLL $1 $> [L (getLoc $1) ((snd $ unLoc $1) [])]) }
2511     | qual                                { sL1 $1 [$1] }
2512 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
2513 --  | '{|' pquals '|}'                       { sL1 $1 [$2] }
2514
2515 -- It is possible to enable bracketing (associating) qualifier lists
2516 -- by uncommenting the lines with {| |} above. Due to a lack of
2517 -- consensus on the syntax, this feature is not being used until we
2518 -- get user demand.
2519
2520 transformqual :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)] -> Stmt RdrName (LHsExpr RdrName)) }
2521                         -- Function is applied to a list of stmts *in order*
2522     : 'then' exp               { sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
2523     | 'then' exp 'by' exp      { sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],\ss -> (mkTransformByStmt ss $2 $4)) }
2524     | 'then' 'group' 'using' exp
2525              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3], \ss -> (mkGroupUsingStmt ss $4)) }
2526
2527     | 'then' 'group' 'by' exp 'using' exp
2528              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5], \ss -> (mkGroupByUsingStmt ss $4 $6)) }
2529
2530 -- Note that 'group' is a special_id, which means that you can enable
2531 -- TransformListComp while still using Data.List.group. However, this
2532 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
2533 -- in by choosing the "group by" variant, which is what we want.
2534
2535 -----------------------------------------------------------------------------
2536 -- Parallel array expressions
2537
2538 -- The rules below are little bit contorted; see the list case for details.
2539 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
2540 -- Moreover, we allow explicit arrays with no element (represented by the nil
2541 -- constructor in the list case).
2542
2543 parr :: { ([AddAnn],HsExpr RdrName) }
2544         :                      { ([],ExplicitPArr placeHolderType []) }
2545         | texp                 { ([],ExplicitPArr placeHolderType [$1]) }
2546         | lexps                { ([],ExplicitPArr placeHolderType
2547                                                           (reverse (unLoc $1))) }
2548         | texp '..' exp        { ([mj AnnDotdot $2]
2549                                  ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
2550         | texp ',' exp '..' exp
2551                         { ([mj AnnComma $2,mj AnnDotdot $4]
2552                           ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
2553         | texp '|' flattenedpquals
2554                         { ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
2555
2556 -- We are reusing `lexps' and `flattenedpquals' from the list case.
2557
2558 -----------------------------------------------------------------------------
2559 -- Guards
2560
2561 guardquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2562     : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
2563
2564 guardquals1 :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2565     : guardquals1 ',' qual  {% addAnnotation (gl $ head $ unLoc $1) AnnComma
2566                                              (gl $2) >>
2567                                return (sLL $1 $> ($3 : unLoc $1)) }
2568     | qual                  { sL1 $1 [$1] }
2569
2570 -----------------------------------------------------------------------------
2571 -- Case alternatives
2572
2573 altslist :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2574         : '{'            alts '}'  { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2575                                                ,(reverse (snd $ unLoc $2))) }
2576         |     vocurly    alts  close { L (getLoc $2) (fst $ unLoc $2
2577                                         ,(reverse (snd $ unLoc $2))) }
2578         | '{'                 '}'    { noLoc ([moc $1,mcc $2],[]) }
2579         |     vocurly          close { noLoc ([],[]) }
2580
2581 alts    :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2582         : alts1                    { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
2583         | ';' alts                 { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
2584                                                ,snd $ unLoc $2) }
2585
2586 alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2587         : alts1 ';' alt         {% if null (snd $ unLoc $1)
2588                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2589                                                   ,[$3]))
2590                                      else (ams (head $ snd $ unLoc $1)
2591                                                (mj AnnSemi $2:(fst $ unLoc $1))
2592                                            >> return (sLL $1 $> ([],$3 : (snd $ unLoc $1))) ) }
2593         | alts1 ';'             {% if null (snd $ unLoc $1)
2594                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2595                                                   ,snd $ unLoc $1))
2596                                      else (ams (head $ snd $ unLoc $1)
2597                                                (mj AnnSemi $2:(fst $ unLoc $1))
2598                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
2599         | alt                   { sL1 $1 ([],[$1]) }
2600
2601 alt     :: { LMatch RdrName (LHsExpr RdrName) }
2602         : pat opt_sig alt_rhs      {%ams (sLL $1 $> (Match Nothing [$1] (snd $2)
2603                                                               (snd $ unLoc $3)))
2604                                          ((fst $2) ++ (fst $ unLoc $3))}
2605
2606 alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2607         : ralt wherebinds           { sLL $1 $> (fst $ unLoc $2,
2608                                             GRHSs (unLoc $1) (snd $ unLoc $2)) }
2609
2610 ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2611         : '->' exp            {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
2612                                      [mj AnnRarrow $1] }
2613         | gdpats              { sL1 $1 (reverse (unLoc $1)) }
2614
2615 gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2616         : gdpats gdpat                  { sLL $1 $> ($2 : unLoc $1) }
2617         | gdpat                         { sL1 $1 [$1] }
2618
2619 -- optional semi-colons between the guards of a MultiWayIf, because we use
2620 -- layout here, but we don't need (or want) the semicolon as a separator (#7783).
2621 gdpatssemi :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2622         : gdpatssemi gdpat optSemi  {% ams (sL (comb2 $1 $2) ($2 : unLoc $1))
2623                                            (map (\l -> mj AnnSemi l) $ fst $3) }
2624         | gdpat optSemi             {% ams (sL1 $1 [$1])
2625                                            (map (\l -> mj AnnSemi l) $ fst $2) }
2626
2627 -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
2628 -- generate the open brace in addition to the vertical bar in the lexer, and
2629 -- we don't need it.
2630 ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
2631          : '{' gdpatssemi '}'             { sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }
2632          |     gdpatssemi close           { sL1 $1 ([],unLoc $1) }
2633
2634 gdpat   :: { LGRHS RdrName (LHsExpr RdrName) }
2635         : '|' guardquals '->' exp
2636                                   {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2637                                          [mj AnnVbar $1,mj AnnRarrow $3] }
2638
2639 -- 'pat' recognises a pattern, including one with a bang at the top
2640 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
2641 -- Bangs inside are parsed as infix operator applications, so that
2642 -- we parse them right when bang-patterns are off
2643 pat     :: { LPat RdrName }
2644 pat     :  exp          {% checkPattern empty $1 }
2645         | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR
2646                                                      (sL1 $1 (HsVar bang_RDR)) $2)))
2647                                 [mj AnnBang $1] }
2648
2649 bindpat :: { LPat RdrName }
2650 bindpat :  exp            {% checkPattern
2651                                 (text "Possibly caused by a missing 'do'?") $1 }
2652         | '!' aexp        {% amms (checkPattern
2653                                      (text "Possibly caused by a missing 'do'?")
2654                                      (sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2)))
2655                                   [mj AnnBang $1] }
2656
2657 apat   :: { LPat RdrName }
2658 apat    : aexp                  {% checkPattern empty $1 }
2659         | '!' aexp              {% amms (checkPattern empty
2660                                             (sLL $1 $> (SectionR
2661                                                 (sL1 $1 (HsVar bang_RDR)) $2)))
2662                                         [mj AnnBang $1] }
2663
2664 apats  :: { [LPat RdrName] }
2665         : apat apats            { $1 : $2 }
2666         | {- empty -}           { [] }
2667
2668 -----------------------------------------------------------------------------
2669 -- Statement sequences
2670
2671 stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2672         : '{'           stmts '}'       { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2673                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
2674         |     vocurly   stmts close     { L (gl $2) (fst $ unLoc $2
2675                                                     ,reverse $ snd $ unLoc $2) }
2676
2677 --      do { ;; s ; s ; ; s ;; }
2678 -- The last Stmt should be an expression, but that's hard to enforce
2679 -- here, because we need too much lookahead if we see do { e ; }
2680 -- So we use BodyStmts throughout, and switch the last one over
2681 -- in ParseUtils.checkDo instead
2682 -- AZ: TODO check that we can retrieve multiple semis.
2683
2684 stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2685         : stmts ';' stmt  {% if null (snd $ unLoc $1)
2686                               then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2687                                                      ,$3 : (snd $ unLoc $1)))
2688                               else do
2689                                { ams (head $ snd $ unLoc $1) [mj AnnSemi $2]
2690                                ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(snd $ unLoc $1)) }}
2691
2692         | stmts ';'     {% if null (snd $ unLoc $1)
2693                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1),snd $ unLoc $1))
2694                              else do
2695                                { ams (head $ snd $ unLoc $1)
2696                                                [mj AnnSemi $2]
2697                                ; return $1 } }
2698         | stmt                   { sL1 $1 ([],[$1]) }
2699         | {- empty -}            { noLoc ([],[]) }
2700
2701
2702 -- For typing stmts at the GHCi prompt, where
2703 -- the input may consist of just comments.
2704 maybe_stmt :: { Maybe (LStmt RdrName (LHsExpr RdrName)) }
2705         : stmt                          { Just $1 }
2706         | {- nothing -}                 { Nothing }
2707
2708 stmt  :: { LStmt RdrName (LHsExpr RdrName) }
2709         : qual                          { $1 }
2710         | 'rec' stmtlist                {% ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
2711                                                (mj AnnRec $1:(fst $ unLoc $2)) }
2712
2713 qual  :: { LStmt RdrName (LHsExpr RdrName) }
2714     : bindpat '<-' exp                  {% ams (sLL $1 $> $ mkBindStmt $1 $3)
2715                                                [mj AnnLarrow $2] }
2716     | exp                               { sL1 $1 $ mkBodyStmt $1 }
2717     | 'let' binds                       {% ams (sLL $1 $>$ LetStmt (snd $ unLoc $2))
2718                                                (mj AnnLet $1:(fst $ unLoc $2)) }
2719
2720 -----------------------------------------------------------------------------
2721 -- Record Field Update/Construction
2722
2723 fbinds  :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2724         : fbinds1                       { $1 }
2725         | {- empty -}                   { ([],([], False)) }
2726
2727 fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2728         : fbind ',' fbinds1
2729                 {% addAnnotation (gl $1) AnnComma (gl $2) >>
2730                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
2731         | fbind                         { ([],([$1], False)) }
2732         | '..'                          { ([mj AnnDotdot $1],([],   True)) }
2733
2734 fbind   :: { LHsRecField RdrName (LHsExpr RdrName) }
2735         : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField $1 $3             False)
2736                                 [mj AnnEqual $2] }
2737                         -- RHS is a 'texp', allowing view patterns (Trac #6038)
2738                         -- and, incidentaly, sections.  Eg
2739                         -- f (R { x = show -> s }) = ...
2740
2741         | qvar          { sLL $1 $> $ HsRecField $1 placeHolderPunRhs True }
2742                         -- In the punning case, use a place-holder
2743                         -- The renamer fills in the final value
2744
2745 -----------------------------------------------------------------------------
2746 -- Implicit Parameter Bindings
2747
2748 dbinds  :: { Located [LIPBind RdrName] }
2749         : dbinds ';' dbind
2750                       {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2751                          return (let { this = $3; rest = unLoc $1 }
2752                               in rest `seq` this `seq` sLL $1 $> (this : rest)) }
2753         | dbinds ';'  {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2754                          return (sLL $1 $> (unLoc $1)) }
2755         | dbind                        { let this = $1 in this `seq` sL1 $1 [this] }
2756 --      | {- empty -}                  { [] }
2757
2758 dbind   :: { LIPBind RdrName }
2759 dbind   : ipvar '=' exp                {% ams (sLL $1 $> (IPBind (Left $1) $3))
2760                                               [mj AnnEqual $2] }
2761
2762 ipvar   :: { Located HsIPName }
2763         : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
2764
2765 -----------------------------------------------------------------------------
2766 -- Warnings and deprecations
2767
2768 name_boolformula_opt :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2769         : name_boolformula          { $1 }
2770         | {- empty -}               { ([],mkTrue) }
2771
2772 name_boolformula :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2773         : name_boolformula_and                      { $1 }
2774         | name_boolformula_and '|' name_boolformula
2775                                              { ((mj AnnVbar $2:fst $1)++(fst $3)
2776                                                 ,Or [snd $1,snd $3]) }
2777
2778 name_boolformula_and :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2779         : name_boolformula_atom                             { $1 }
2780         | name_boolformula_atom ',' name_boolformula_and
2781                   { ((mj AnnComma $2:fst $1)++(fst $3), And [snd $1,snd $3]) }
2782
2783 name_boolformula_atom :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2784         : '(' name_boolformula ')'  { ((mop $1:mcp $3:(fst $2)),snd $2) }
2785         | name_var                  { ([],Var $1) }
2786
2787 namelist :: { Located [Located RdrName] }
2788 namelist : name_var              { sL1 $1 [$1] }
2789          | name_var ',' namelist {% addAnnotation (gl $1) AnnComma (gl $2) >>
2790                                     return (sLL $1 $> ($1 : unLoc $3)) }
2791
2792 name_var :: { Located RdrName }
2793 name_var : var { $1 }
2794          | con { $1 }
2795
2796 -----------------------------------------
2797 -- Data constructors
2798 -- There are two different productions here as lifted list constructors
2799 -- are parsed differently.
2800
2801 qcon_nowiredlist :: { Located RdrName }
2802         : gen_qcon                     { $1 }
2803         | sysdcon_nolist               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2804
2805 qcon :: { Located RdrName }
2806   : gen_qcon              { $1}
2807   | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2808
2809 gen_qcon :: { Located RdrName }
2810   : qconid                { $1 }
2811   | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))
2812                                    [mop $1,mj AnnVal $2,mcp $3] }
2813
2814 -- The case of '[:' ':]' is part of the production `parr'
2815
2816 con     :: { Located RdrName }
2817         : conid                 { $1 }
2818         | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))
2819                                        [mop $1,mj AnnVal $2,mcp $3] }
2820         | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2821
2822 con_list :: { Located [Located RdrName] }
2823 con_list : con                  { sL1 $1 [$1] }
2824          | con ',' con_list     {% addAnnotation (gl $1) AnnComma (gl $2) >>
2825                                    return (sLL $1 $> ($1 : unLoc $3)) }
2826
2827 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
2828         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
2829         | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
2830                                        (mop $1:mcp $3:(mcommas (fst $2))) }
2831         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
2832         | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
2833                                        (mo $1:mc $3:(mcommas (fst $2))) }
2834
2835 sysdcon :: { Located DataCon }
2836         : sysdcon_nolist                 { $1 }
2837         | '[' ']'               {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] }
2838
2839 conop :: { Located RdrName }
2840         : consym                { $1 }
2841         | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2))
2842                                        [mj AnnBackquote $1,mj AnnVal $2
2843                                        ,mj AnnBackquote $3] }
2844
2845 qconop :: { Located RdrName }
2846         : qconsym               { $1 }
2847         | '`' qconid '`'        {% ams (sLL $1 $> (unLoc $2))
2848                                        [mj AnnBackquote $1,mj AnnVal $2
2849                                        ,mj AnnBackquote $3] }
2850
2851 ----------------------------------------------------------------------------
2852 -- Type constructors
2853
2854
2855 -- See Note [Unit tuples] in HsTypes for the distinction
2856 -- between gtycon and ntgtycon
2857 gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
2858         : ntgtycon                     { $1 }
2859         | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)
2860                                               [mop $1,mcp $2] }
2861         | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)
2862                                               [mo $1,mc $2] }
2863
2864 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
2865         : oqtycon               { $1 }
2866         | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
2867                                                         (snd $2 + 1)))
2868                                        (mop $1:mcp $3:(mcommas (fst $2))) }
2869         | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
2870                                                         (snd $2 + 1)))
2871                                        (mo $1:mc $3:(mcommas (fst $2))) }
2872         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
2873                                        [mop $1,mj AnnRarrow $2,mcp $3] }
2874         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
2875         | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
2876         | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
2877                                         [mop $1,mj AnnTildehsh $2,mcp $3] }
2878
2879 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
2880                                 -- These can appear in export lists
2881         : qtycon                        { $1 }
2882         | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2))
2883                                                [mop $1,mj AnnVal $2,mcp $3] }
2884         | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)
2885                                                [mop $1,mj AnnTilde $2,mcp $3] }
2886
2887 qtyconop :: { Located RdrName } -- Qualified or unqualified
2888         : qtyconsym                     { $1 }
2889         | '`' qtycon '`'                {% ams (sLL $1 $> (unLoc $2))
2890                                                [mj AnnBackquote $1,mj AnnVal $2
2891                                                ,mj AnnBackquote $3] }
2892
2893 qtycon :: { Located RdrName }   -- Qualified or unqualified
2894         : QCONID            { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
2895         | PREFIXQCONSYM     { sL1 $1 $! mkQual tcClsName (getPREFIXQCONSYM $1) }
2896         | tycon             { $1 }
2897
2898 tycon   :: { Located RdrName }  -- Unqualified
2899         : CONID                   { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
2900
2901 qtyconsym :: { Located RdrName }
2902         : QCONSYM            { sL1 $1 $! mkQual tcClsName (getQCONSYM $1) }
2903         | QVARSYM            { sL1 $1 $! mkQual tcClsName (getQVARSYM $1) }
2904         | tyconsym           { $1 }
2905
2906 -- Does not include "!", because that is used for strictness marks
2907 --               or ".", because that separates the quantified type vars from the rest
2908 tyconsym :: { Located RdrName }
2909         : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
2910         | VARSYM                { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
2911         | ':'                   { sL1 $1 $! consDataCon_RDR }
2912         | '*'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "*") }
2913         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
2914
2915
2916 -----------------------------------------------------------------------------
2917 -- Operators
2918
2919 op      :: { Located RdrName }   -- used in infix decls
2920         : varop                 { $1 }
2921         | conop                 { $1 }
2922
2923 varop   :: { Located RdrName }
2924         : varsym                { $1 }
2925         | '`' varid '`'         {% ams (sLL $1 $> (unLoc $2))
2926                                        [mj AnnBackquote $1,mj AnnVal $2
2927                                        ,mj AnnBackquote $3] }
2928
2929 qop     :: { LHsExpr RdrName }   -- used in sections
2930         : qvarop                { sL1 $1 $ HsVar (unLoc $1) }
2931         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2932
2933 qopm    :: { LHsExpr RdrName }   -- used in sections
2934         : qvaropm               { sL1 $1 $ HsVar (unLoc $1) }
2935         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2936
2937 qvarop :: { Located RdrName }
2938         : qvarsym               { $1 }
2939         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
2940                                        [mj AnnBackquote $1,mj AnnVal $2
2941                                        ,mj AnnBackquote $3] }
2942
2943 qvaropm :: { Located RdrName }
2944         : qvarsym_no_minus      { $1 }
2945         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
2946                                        [mj AnnBackquote $1,mj AnnVal $2
2947                                        ,mj AnnBackquote $3] }
2948
2949 -----------------------------------------------------------------------------
2950 -- Type variables
2951
2952 tyvar   :: { Located RdrName }
2953 tyvar   : tyvarid               { $1 }
2954
2955 tyvarop :: { Located RdrName }
2956 tyvarop : '`' tyvarid '`'       {% ams (sLL $1 $> (unLoc $2))
2957                                        [mj AnnBackquote $1,mj AnnVal $2
2958                                        ,mj AnnBackquote $3] }
2959         | '.'                   {% parseErrorSDoc (getLoc $1)
2960                                       (vcat [ptext (sLit "Illegal symbol '.' in type"),
2961                                              ptext (sLit "Perhaps you intended to use RankNTypes or a similar language"),
2962                                              ptext (sLit "extension to enable explicit-forall syntax: forall <tvs>. <type>")])
2963                                 }
2964
2965 tyvarid :: { Located RdrName }
2966         : VARID            { sL1 $1 $! mkUnqual tvName (getVARID $1) }
2967         | special_id       { sL1 $1 $! mkUnqual tvName (unLoc $1) }
2968         | 'unsafe'         { sL1 $1 $! mkUnqual tvName (fsLit "unsafe") }
2969         | 'safe'           { sL1 $1 $! mkUnqual tvName (fsLit "safe") }
2970         | 'interruptible'  { sL1 $1 $! mkUnqual tvName (fsLit "interruptible") }
2971
2972 -----------------------------------------------------------------------------
2973 -- Variables
2974
2975 var     :: { Located RdrName }
2976         : varid                 { $1 }
2977         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
2978                                        [mop $1,mj AnnVal $2,mcp $3] }
2979
2980 qvar    :: { Located RdrName }
2981         : qvarid                { $1 }
2982         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
2983                                        [mop $1,mj AnnVal $2,mcp $3] }
2984         | '(' qvarsym1 ')'      {% ams (sLL $1 $> (unLoc $2))
2985                                        [mop $1,mj AnnVal $2,mcp $3] }
2986 -- We've inlined qvarsym here so that the decision about
2987 -- whether it's a qvar or a var can be postponed until
2988 -- *after* we see the close paren.
2989
2990 qvarid :: { Located RdrName }
2991         : varid               { $1 }
2992         | QVARID              { sL1 $1 $! mkQual varName (getQVARID $1) }
2993         | PREFIXQVARSYM       { sL1 $1 $! mkQual varName (getPREFIXQVARSYM $1) }
2994
2995 -- Note that 'role' and 'family' get lexed separately regardless of
2996 -- the use of extensions. However, because they are listed here, this
2997 -- is OK and they can be used as normal varids.
2998 varid :: { Located RdrName }
2999         : VARID            { sL1 $1 $! mkUnqual varName (getVARID $1) }
3000         | special_id       { sL1 $1 $! mkUnqual varName (unLoc $1) }
3001         | 'unsafe'         { sL1 $1 $! mkUnqual varName (fsLit "unsafe") }
3002         | 'safe'           { sL1 $1 $! mkUnqual varName (fsLit "safe") }
3003         | 'interruptible'  { sL1 $1 $! mkUnqual varName (fsLit "interruptible")}
3004         | 'forall'         { sL1 $1 $! mkUnqual varName (fsLit "forall") }
3005         | 'family'         { sL1 $1 $! mkUnqual varName (fsLit "family") }
3006         | 'role'           { sL1 $1 $! mkUnqual varName (fsLit "role") }
3007
3008 qvarsym :: { Located RdrName }
3009         : varsym                { $1 }
3010         | qvarsym1              { $1 }
3011
3012 qvarsym_no_minus :: { Located RdrName }
3013         : varsym_no_minus       { $1 }
3014         | qvarsym1              { $1 }
3015
3016 qvarsym1 :: { Located RdrName }
3017 qvarsym1 : QVARSYM              { sL1 $1 $ mkQual varName (getQVARSYM $1) }
3018
3019 varsym :: { Located RdrName }
3020         : varsym_no_minus       { $1 }
3021         | '-'                   { sL1 $1 $ mkUnqual varName (fsLit "-") }
3022
3023 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
3024         : VARSYM               { sL1 $1 $ mkUnqual varName (getVARSYM $1) }
3025         | special_sym          { sL1 $1 $ mkUnqual varName (unLoc $1) }
3026
3027
3028 -- These special_ids are treated as keywords in various places,
3029 -- but as ordinary ids elsewhere.   'special_id' collects all these
3030 -- except 'unsafe', 'interruptible', 'forall', 'family', and 'role',
3031 -- whose treatment differs depending on context
3032 special_id :: { Located FastString }
3033 special_id
3034         : 'as'                  { sL1 $1 (fsLit "as") }
3035         | 'qualified'           { sL1 $1 (fsLit "qualified") }
3036         | 'hiding'              { sL1 $1 (fsLit "hiding") }
3037         | 'export'              { sL1 $1 (fsLit "export") }
3038         | 'label'               { sL1 $1 (fsLit "label")  }
3039         | 'dynamic'             { sL1 $1 (fsLit "dynamic") }
3040         | 'stdcall'             { sL1 $1 (fsLit "stdcall") }
3041         | 'ccall'               { sL1 $1 (fsLit "ccall") }
3042         | 'capi'                { sL1 $1 (fsLit "capi") }
3043         | 'prim'                { sL1 $1 (fsLit "prim") }
3044         | 'javascript'          { sL1 $1 (fsLit "javascript") }
3045         | 'group'               { sL1 $1 (fsLit "group") }
3046
3047 special_sym :: { Located FastString }
3048 special_sym : '!'       {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
3049             | '.'       { sL1 $1 (fsLit ".") }
3050             | '*'       { sL1 $1 (fsLit "*") }
3051
3052 -----------------------------------------------------------------------------
3053 -- Data constructors
3054
3055 qconid :: { Located RdrName }   -- Qualified or unqualified
3056         : conid              { $1 }
3057         | QCONID             { sL1 $1 $! mkQual dataName (getQCONID $1) }
3058         | PREFIXQCONSYM      { sL1 $1 $! mkQual dataName (getPREFIXQCONSYM $1) }
3059
3060 conid   :: { Located RdrName }
3061         : CONID                { sL1 $1 $ mkUnqual dataName (getCONID $1) }
3062
3063 qconsym :: { Located RdrName }  -- Qualified or unqualified
3064         : consym               { $1 }
3065         | QCONSYM              { sL1 $1 $ mkQual dataName (getQCONSYM $1) }
3066
3067 consym :: { Located RdrName }
3068         : CONSYM              { sL1 $1 $ mkUnqual dataName (getCONSYM $1) }
3069
3070         -- ':' means only list cons
3071         | ':'                { sL1 $1 $ consDataCon_RDR }
3072
3073
3074 -----------------------------------------------------------------------------
3075 -- Literals
3076
3077 literal :: { Located HsLit }
3078         : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }
3079         | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)
3080                                                    $ getSTRING $1 }
3081         | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)
3082                                                    $ getPRIMINTEGER $1 }
3083         | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)
3084                                                    $ getPRIMWORD $1 }
3085         | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)
3086                                                    $ getPRIMCHAR $1 }
3087         | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
3088                                                    $ getPRIMSTRING $1 }
3089         | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
3090         | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
3091
3092 -----------------------------------------------------------------------------
3093 -- Layout
3094
3095 close :: { () }
3096         : vccurly               { () } -- context popped in lexer.
3097         | error                 {% popContext }
3098
3099 -----------------------------------------------------------------------------
3100 -- Miscellaneous (mostly renamings)
3101
3102 modid   :: { Located ModuleName }
3103         : CONID                 { sL1 $1 $ mkModuleNameFS (getCONID $1) }
3104         | QCONID                { sL1 $1 $ let (mod,c) = getQCONID $1 in
3105                                   mkModuleNameFS
3106                                    (mkFastString
3107                                      (unpackFS mod ++ '.':unpackFS c))
3108                                 }
3109
3110 commas :: { ([SrcSpan],Int) }   -- One or more commas
3111         : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }
3112         | ','                    { ([gl $1],1) }
3113
3114 -----------------------------------------------------------------------------
3115 -- Documentation comments
3116
3117 docnext :: { LHsDocString }
3118   : DOCNEXT {% return (sL1 $1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
3119
3120 docprev :: { LHsDocString }
3121   : DOCPREV {% return (sL1 $1 (HsDocString (mkFastString (getDOCPREV $1)))) }
3122
3123 docnamed :: { Located (String, HsDocString) }
3124   : DOCNAMED {%
3125       let string = getDOCNAMED $1
3126           (name, rest) = break isSpace string
3127       in return (sL1 $1 (name, HsDocString (mkFastString rest))) }
3128
3129 docsection :: { Located (Int, HsDocString) }
3130   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
3131         return (sL1 $1 (n, HsDocString (mkFastString doc))) }
3132
3133 moduleheader :: { Maybe LHsDocString }
3134         : DOCNEXT {% let string = getDOCNEXT $1 in
3135                      return (Just (sL1 $1 (HsDocString (mkFastString string)))) }
3136
3137 maybe_docprev :: { Maybe LHsDocString }
3138         : docprev                       { Just $1 }
3139         | {- empty -}                   { Nothing }
3140
3141 maybe_docnext :: { Maybe LHsDocString }
3142         : docnext                       { Just $1 }
3143         | {- empty -}                   { Nothing }
3144
3145 {
3146 happyError :: P a
3147 happyError = srcParseFail
3148
3149 getVARID        (L _ (ITvarid    x)) = x
3150 getCONID        (L _ (ITconid    x)) = x
3151 getVARSYM       (L _ (ITvarsym   x)) = x
3152 getCONSYM       (L _ (ITconsym   x)) = x
3153 getQVARID       (L _ (ITqvarid   x)) = x
3154 getQCONID       (L _ (ITqconid   x)) = x
3155 getQVARSYM      (L _ (ITqvarsym  x)) = x
3156 getQCONSYM      (L _ (ITqconsym  x)) = x
3157 getPREFIXQVARSYM (L _ (ITprefixqvarsym  x)) = x
3158 getPREFIXQCONSYM (L _ (ITprefixqconsym  x)) = x
3159 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
3160 getCHAR         (L _ (ITchar   _ x)) = x
3161 getSTRING       (L _ (ITstring _ x)) = x
3162 getINTEGER      (L _ (ITinteger _ x)) = x
3163 getRATIONAL     (L _ (ITrational x)) = x
3164 getPRIMCHAR     (L _ (ITprimchar _ x)) = x
3165 getPRIMSTRING   (L _ (ITprimstring _ x)) = x
3166 getPRIMINTEGER  (L _ (ITprimint  _ x)) = x
3167 getPRIMWORD     (L _ (ITprimword _ x)) = x
3168 getPRIMFLOAT    (L _ (ITprimfloat x)) = x
3169 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
3170 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
3171 getTH_ID_TY_SPLICE (L _ (ITidTyEscape x)) = x
3172 getINLINE       (L _ (ITinline_prag _ inl conl)) = (inl,conl)
3173 getSPEC_INLINE  (L _ (ITspec_inline_prag _ True))  = (Inline,  FunLike)
3174 getSPEC_INLINE  (L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)
3175
3176 getDOCNEXT (L _ (ITdocCommentNext x)) = x
3177 getDOCPREV (L _ (ITdocCommentPrev x)) = x
3178 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
3179 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
3180
3181 getCHARs        (L _ (ITchar       src _)) = src
3182 getSTRINGs      (L _ (ITstring     src _)) = src
3183 getINTEGERs     (L _ (ITinteger    src _)) = src
3184 getPRIMCHARs    (L _ (ITprimchar   src _)) = src
3185 getPRIMSTRINGs  (L _ (ITprimstring src _)) = src
3186 getPRIMINTEGERs (L _ (ITprimint    src _)) = src
3187 getPRIMWORDs    (L _ (ITprimword   src _)) = src
3188
3189 -- See Note [Pragma source text] in BasicTypes for the following
3190 getINLINE_PRAGs       (L _ (ITinline_prag       src _ _)) = src
3191 getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src
3192 getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src
3193 getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src
3194 getRULES_PRAGs        (L _ (ITrules_prag        src)) = src
3195 getWARNING_PRAGs      (L _ (ITwarning_prag      src)) = src
3196 getDEPRECATED_PRAGs   (L _ (ITdeprecated_prag   src)) = src
3197 getSCC_PRAGs          (L _ (ITscc_prag          src)) = src
3198 getGENERATED_PRAGs    (L _ (ITgenerated_prag    src)) = src
3199 getCORE_PRAGs         (L _ (ITcore_prag         src)) = src
3200 getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src
3201 getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src
3202 getANN_PRAGs          (L _ (ITann_prag          src)) = src
3203 getVECT_PRAGs         (L _ (ITvect_prag         src)) = src
3204 getVECT_SCALAR_PRAGs  (L _ (ITvect_scalar_prag  src)) = src
3205 getNOVECT_PRAGs       (L _ (ITnovect_prag       src)) = src
3206 getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src
3207 getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src
3208 getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src
3209 getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src
3210 getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src
3211 getCTYPEs             (L _ (ITctype             src)) = src
3212
3213
3214 getSCC :: Located Token -> P FastString
3215 getSCC lt = do let s = getSTRING lt
3216                    err = "Spaces are not allowed in SCCs"
3217                -- We probably actually want to be more restrictive than this
3218                if ' ' `elem` unpackFS s
3219           &