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