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