78f1013151be2cd02000688d41d2f48402138599
[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 $ TyElOpr (unLoc $1) }
1993         | tyvarop                       { sL1 $1 $ TyElOpr (unLoc $1) }
1994         | SIMPLEQUOTE qconop            {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
1995                                                [mj AnnSimpleQuote $1,mj AnnVal $2] }
1996         | SIMPLEQUOTE varop             {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
1997                                                [mj AnnSimpleQuote $1,mj AnnVal $2] }
1998         | '~'                           { sL1 $1 TyElTilde }
1999         | '!'                           { sL1 $1 TyElBang }
2000         | unpackedness                  { sL1 $1 $ TyElUnpackedness (unLoc $1) }
2001
2002 atype :: { LHsType GhcPs }
2003         : ntgtycon                       { sL1 $1 (HsTyVar noExt NotPromoted $1) }      -- Not including unit tuples
2004         | tyvar                          { sL1 $1 (HsTyVar noExt NotPromoted $1) }      -- (See Note [Unit tuples])
2005         | '*'                            {% do { warnStarIsType (getLoc $1)
2006                                                ; return $ sL1 $1 (HsStarTy noExt (isUnicode $1)) } }
2007         | '{' fielddecls '}'             {% amms (checkRecordSyntax
2008                                                     (sLL $1 $> $ HsRecTy noExt $2))
2009                                                         -- Constructor sigs only
2010                                                  [moc $1,mcc $3] }
2011         | '(' ')'                        {% ams (sLL $1 $> $ HsTupleTy noExt
2012                                                     HsBoxedOrConstraintTuple [])
2013                                                 [mop $1,mcp $2] }
2014         | '(' ktype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
2015                                                           (gl $3) >>
2016                                             ams (sLL $1 $> $ HsTupleTy noExt
2017
2018                                              HsBoxedOrConstraintTuple ($2 : $4))
2019                                                 [mop $1,mcp $5] }
2020         | '(#' '#)'                   {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple [])
2021                                              [mo $1,mc $2] }
2022         | '(#' comma_types1 '#)'      {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple $2)
2023                                              [mo $1,mc $3] }
2024         | '(#' bar_types2 '#)'        {% ams (sLL $1 $> $ HsSumTy noExt $2)
2025                                              [mo $1,mc $3] }
2026         | '[' ktype ']'               {% ams (sLL $1 $> $ HsListTy  noExt $2) [mos $1,mcs $3] }
2027         | '(' ktype ')'               {% ams (sLL $1 $> $ HsParTy   noExt $2) [mop $1,mcp $3] }
2028         | quasiquote                  { mapLoc (HsSpliceTy noExt) $1 }
2029         | splice_untyped              { mapLoc (HsSpliceTy noExt) $1 }
2030                                       -- see Note [Promotion] for the followings
2031         | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
2032         | SIMPLEQUOTE  '(' ktype ',' comma_types1 ')'
2033                              {% addAnnotation (gl $3) AnnComma (gl $4) >>
2034                                 ams (sLL $1 $> $ HsExplicitTupleTy noExt ($3 : $5))
2035                                     [mj AnnSimpleQuote $1,mop $2,mcp $6] }
2036         | SIMPLEQUOTE  '[' comma_types0 ']'     {% ams (sLL $1 $> $ HsExplicitListTy noExt IsPromoted $3)
2037                                                        [mj AnnSimpleQuote $1,mos $2,mcs $4] }
2038         | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2)
2039                                                        [mj AnnSimpleQuote $1,mj AnnName $2] }
2040
2041         -- Two or more [ty, ty, ty] must be a promoted list type, just as
2042         -- if you had written '[ty, ty, ty]
2043         -- (One means a list type, zero means the list type constructor,
2044         -- so you have to quote those.)
2045         | '[' ktype ',' comma_types1 ']'  {% addAnnotation (gl $2) AnnComma
2046                                                            (gl $3) >>
2047                                              ams (sLL $1 $> $ HsExplicitListTy noExt NotPromoted ($2 : $4))
2048                                                  [mos $1,mcs $5] }
2049         | INTEGER              { sLL $1 $> $ HsTyLit noExt $ HsNumTy (getINTEGERs $1)
2050                                                            (il_value (getINTEGER $1)) }
2051         | STRING               { sLL $1 $> $ HsTyLit noExt $ HsStrTy (getSTRINGs $1)
2052                                                                      (getSTRING  $1) }
2053         | '_'                  { sL1 $1 $ mkAnonWildCardTy }
2054
2055 -- An inst_type is what occurs in the head of an instance decl
2056 --      e.g.  (Foo a, Gaz b) => Wibble a b
2057 -- It's kept as a single type for convenience.
2058 inst_type :: { LHsSigType GhcPs }
2059         : sigtype                       { mkLHsSigType $1 }
2060
2061 deriv_types :: { [LHsSigType GhcPs] }
2062         : typedoc                       { [mkLHsSigType $1] }
2063
2064         | typedoc ',' deriv_types       {% addAnnotation (gl $1) AnnComma (gl $2)
2065                                            >> return (mkLHsSigType $1 : $3) }
2066
2067 comma_types0  :: { [LHsType GhcPs] }  -- Zero or more:  ty,ty,ty
2068         : comma_types1                  { $1 }
2069         | {- empty -}                   { [] }
2070
2071 comma_types1    :: { [LHsType GhcPs] }  -- One or more:  ty,ty,ty
2072         : ktype                        { [$1] }
2073         | ktype  ',' comma_types1      {% addAnnotation (gl $1) AnnComma (gl $2)
2074                                           >> return ($1 : $3) }
2075
2076 bar_types2    :: { [LHsType GhcPs] }  -- Two or more:  ty|ty|ty
2077         : ktype  '|' ktype             {% addAnnotation (gl $1) AnnVbar (gl $2)
2078                                           >> return [$1,$3] }
2079         | ktype  '|' bar_types2        {% addAnnotation (gl $1) AnnVbar (gl $2)
2080                                           >> return ($1 : $3) }
2081
2082 tv_bndrs :: { [LHsTyVarBndr GhcPs] }
2083          : tv_bndr tv_bndrs             { $1 : $2 }
2084          | {- empty -}                  { [] }
2085
2086 tv_bndr :: { LHsTyVarBndr GhcPs }
2087         : tyvar                         { sL1 $1 (UserTyVar noExt $1) }
2088         | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar noExt $2 $4))
2089                                                [mop $1,mu AnnDcolon $3
2090                                                ,mcp $5] }
2091
2092 fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
2093         : {- empty -}                   { noLoc ([],[]) }
2094         | '|' fds1                      { (sLL $1 $> ([mj AnnVbar $1]
2095                                                  ,reverse (unLoc $2))) }
2096
2097 fds1 :: { Located [Located (FunDep (Located RdrName))] }
2098         : fds1 ',' fd   {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2)
2099                            >> return (sLL $1 $> ($3 : unLoc $1)) }
2100         | fd            { sL1 $1 [$1] }
2101
2102 fd :: { Located (FunDep (Located RdrName)) }
2103         : varids0 '->' varids0  {% ams (cL (comb3 $1 $2 $3)
2104                                        (reverse (unLoc $1), reverse (unLoc $3)))
2105                                        [mu AnnRarrow $2] }
2106
2107 varids0 :: { Located [Located RdrName] }
2108         : {- empty -}                   { noLoc [] }
2109         | varids0 tyvar                 { sLL $1 $> ($2 : unLoc $1) }
2110
2111 -----------------------------------------------------------------------------
2112 -- Kinds
2113
2114 kind :: { LHsKind GhcPs }
2115         : ctype                  { $1 }
2116
2117 {- Note [Promotion]
2118    ~~~~~~~~~~~~~~~~
2119
2120 - Syntax of promoted qualified names
2121 We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
2122 names. Moreover ticks are only allowed in types, not in kinds, for a
2123 few reasons:
2124   1. we don't need quotes since we cannot define names in kinds
2125   2. if one day we merge types and kinds, tick would mean look in DataName
2126   3. we don't have a kind namespace anyway
2127
2128 - Name resolution
2129 When the user write Zero instead of 'Zero in types, we parse it a
2130 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
2131 deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
2132 bounded in the type level, then we look for it in the term level (we
2133 change its namespace to DataName, see Note [Demotion] in OccName). And
2134 both become a HsTyVar ("Zero", DataName) after the renamer.
2135
2136 -}
2137
2138
2139 -----------------------------------------------------------------------------
2140 -- Datatype declarations
2141
2142 gadt_constrlist :: { Located ([AddAnn]
2143                           ,[LConDecl GhcPs]) } -- Returned in order
2144
2145         : 'where' '{'        gadt_constrs '}'    {% checkEmptyGADTs $
2146                                                       cL (comb2 $1 $3)
2147                                                         ([mj AnnWhere $1
2148                                                          ,moc $2
2149                                                          ,mcc $4]
2150                                                         , unLoc $3) }
2151         | 'where' vocurly    gadt_constrs close  {% checkEmptyGADTs $
2152                                                       cL (comb2 $1 $3)
2153                                                         ([mj AnnWhere $1]
2154                                                         , unLoc $3) }
2155         | {- empty -}                            { noLoc ([],[]) }
2156
2157 gadt_constrs :: { Located [LConDecl GhcPs] }
2158         : gadt_constr_with_doc ';' gadt_constrs
2159                   {% addAnnotation (gl $1) AnnSemi (gl $2)
2160                      >> return (cL (comb2 $1 $3) ($1 : unLoc $3)) }
2161         | gadt_constr_with_doc          { cL (gl $1) [$1] }
2162         | {- empty -}                   { noLoc [] }
2163
2164 -- We allow the following forms:
2165 --      C :: Eq a => a -> T a
2166 --      C :: forall a. Eq a => !a -> T a
2167 --      D { x,y :: a } :: T a
2168 --      forall a. Eq a => D { x,y :: a } :: T a
2169
2170 gadt_constr_with_doc :: { LConDecl GhcPs }
2171 gadt_constr_with_doc
2172         : maybe_docnext ';' gadt_constr
2173                 {% return $ addConDoc $3 $1 }
2174         | gadt_constr
2175                 {% return $1 }
2176
2177 gadt_constr :: { LConDecl GhcPs }
2178     -- see Note [Difference in parsing GADT and data constructors]
2179     -- Returns a list because of:   C,D :: ty
2180         : con_list '::' sigtypedoc
2181                 {% let (gadt,anns) = mkGadtDecl (unLoc $1) $3
2182                    in ams (sLL $1 $> gadt)
2183                        (mu AnnDcolon $2:anns) }
2184
2185 {- Note [Difference in parsing GADT and data constructors]
2186 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2187 GADT constructors have simpler syntax than usual data constructors:
2188 in GADTs, types cannot occur to the left of '::', so they cannot be mixed
2189 with constructor names (see Note [Parsing data constructors is hard]).
2190
2191 Due to simplified syntax, GADT constructor names (left-hand side of '::')
2192 use simpler grammar production than usual data constructor names. As a
2193 consequence, GADT constructor names are resticted (names like '(*)' are
2194 allowed in usual data constructors, but not in GADTs).
2195 -}
2196
2197 constrs :: { Located ([AddAnn],[LConDecl GhcPs]) }
2198         : maybe_docnext '=' constrs1    { cL (comb2 $2 $3) ([mj AnnEqual $2]
2199                                                      ,addConDocs (unLoc $3) $1)}
2200
2201 constrs1 :: { Located [LConDecl GhcPs] }
2202         : constrs1 maybe_docnext '|' maybe_docprev constr
2203             {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
2204                >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
2205         | constr                                          { sL1 $1 [$1] }
2206
2207 {- Note [Constr variatons of non-terminals]
2208 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2209
2210 In record declarations we assume that 'ctype' used to parse the type will not
2211 consume the trailing docprev:
2212
2213   data R = R { field :: Int -- ^ comment on the field }
2214
2215 In 'R' we expect the comment to apply to the entire field, not to 'Int'. The
2216 same issue is detailed in Note [ctype and ctypedoc].
2217
2218 So, we do not want 'ctype'  to consume 'docprev', therefore
2219     we do not want 'btype'  to consume 'docprev', therefore
2220     we do not want 'tyapps' to consume 'docprev'.
2221
2222 At the same time, when parsing a 'constr', we do want to consume 'docprev':
2223
2224   data T = C Int  -- ^ comment on Int
2225              Bool -- ^ comment on Bool
2226
2227 So, we do want 'constr_stuff' to consume 'docprev'.
2228
2229 The problem arises because the clauses in 'constr' have the following
2230 structure:
2231
2232   (a)  context '=>' constr_stuff   (e.g.  data T a = Ord a => C a)
2233   (b)               constr_stuff   (e.g.  data T a =          C a)
2234
2235 and to avoid a reduce/reduce conflict, 'context' and 'constr_stuff' must be
2236 compatible. And for 'context' to be compatible with 'constr_stuff', it must
2237 consume 'docprev'.
2238
2239 So, we want 'context'  to consume 'docprev', therefore
2240     we want 'btype'    to consume 'docprev', therefore
2241     we want 'tyapps'   to consume 'docprev'.
2242
2243 Our requirements end up conflicting: for parsing record types, we want 'tyapps'
2244 to leave 'docprev' alone, but for parsing constructors, we want it to consume
2245 'docprev'.
2246
2247 As the result, we maintain two parallel hierarchies of non-terminals that
2248 either consume 'docprev' or not:
2249
2250   tyapps      constr_tyapps
2251   btype       constr_btype
2252   context     constr_context
2253   ...
2254
2255 They must be kept identical except for their treatment of 'docprev'.
2256
2257 -}
2258
2259 constr :: { LConDecl GhcPs }
2260         : maybe_docnext forall constr_context '=>' constr_stuff
2261                 {% ams (let (con,details,doc_prev) = unLoc $5 in
2262                   addConDoc (cL (comb4 $2 $3 $4 $5) (mkConDeclH98 con
2263                                                        (snd $ unLoc $2)
2264                                                        (Just $3)
2265                                                        details))
2266                             ($1 `mplus` doc_prev))
2267                         (mu AnnDarrow $4:(fst $ unLoc $2)) }
2268         | maybe_docnext forall constr_stuff
2269                 {% ams ( let (con,details,doc_prev) = unLoc $3 in
2270                   addConDoc (cL (comb2 $2 $3) (mkConDeclH98 con
2271                                                       (snd $ unLoc $2)
2272                                                       Nothing   -- No context
2273                                                       details))
2274                             ($1 `mplus` doc_prev))
2275                        (fst $ unLoc $2) }
2276
2277 forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr GhcPs]) }
2278         : 'forall' tv_bndrs '.'       { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }
2279         | {- empty -}                 { noLoc ([], Nothing) }
2280
2281 constr_stuff :: { Located (Located RdrName, HsConDeclDetails GhcPs, Maybe LHsDocString) }
2282         : constr_tyapps                    {% do { c <- mergeDataCon (unLoc $1)
2283                                                  ; return $ sL1 $1 c } }
2284
2285 fielddecls :: { [LConDeclField GhcPs] }
2286         : {- empty -}     { [] }
2287         | fielddecls1     { $1 }
2288
2289 fielddecls1 :: { [LConDeclField GhcPs] }
2290         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
2291             {% addAnnotation (gl $1) AnnComma (gl $3) >>
2292                return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
2293         | fielddecl   { [$1] }
2294
2295 fielddecl :: { LConDeclField GhcPs }
2296                                               -- A list because of   f,g :: Int
2297         : maybe_docnext sig_vars '::' ctype maybe_docprev
2298             {% ams (cL (comb2 $2 $4)
2299                       (ConDeclField noExt (reverse (map (\ln@(dL->L l n) -> cL l $ FieldOcc noExt ln) (unLoc $2))) $4 ($1 `mplus` $5)))
2300                    [mu AnnDcolon $3] }
2301
2302 -- Reversed!
2303 maybe_derivings :: { HsDeriving GhcPs }
2304         : {- empty -}             { noLoc [] }
2305         | derivings               { $1 }
2306
2307 -- A list of one or more deriving clauses at the end of a datatype
2308 derivings :: { HsDeriving GhcPs }
2309         : derivings deriving      { sLL $1 $> $ $2 : unLoc $1 }
2310         | deriving                { sLL $1 $> [$1] }
2311
2312 -- The outer Located is just to allow the caller to
2313 -- know the rightmost extremity of the 'deriving' clause
2314 deriving :: { LHsDerivingClause GhcPs }
2315         : 'deriving' deriv_clause_types
2316               {% let { full_loc = comb2 $1 $> }
2317                  in ams (cL full_loc $ HsDerivingClause noExt Nothing $2)
2318                         [mj AnnDeriving $1] }
2319
2320         | 'deriving' deriv_strategy_no_via deriv_clause_types
2321               {% let { full_loc = comb2 $1 $> }
2322                  in ams (cL full_loc $ HsDerivingClause noExt (Just $2) $3)
2323                         [mj AnnDeriving $1] }
2324
2325         | 'deriving' deriv_clause_types deriv_strategy_via
2326               {% let { full_loc = comb2 $1 $> }
2327                  in ams (cL full_loc $ HsDerivingClause noExt (Just $3) $2)
2328                         [mj AnnDeriving $1] }
2329
2330 deriv_clause_types :: { Located [LHsSigType GhcPs] }
2331         : qtycondoc           { sL1 $1 [mkLHsSigType $1] }
2332         | '(' ')'             {% ams (sLL $1 $> [])
2333                                      [mop $1,mcp $2] }
2334         | '(' deriv_types ')' {% ams (sLL $1 $> $2)
2335                                      [mop $1,mcp $3] }
2336              -- Glasgow extension: allow partial
2337              -- applications in derivings
2338
2339 -----------------------------------------------------------------------------
2340 -- Value definitions
2341
2342 {- Note [Declaration/signature overlap]
2343 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2344 There's an awkward overlap with a type signature.  Consider
2345         f :: Int -> Int = ...rhs...
2346    Then we can't tell whether it's a type signature or a value
2347    definition with a result signature until we see the '='.
2348    So we have to inline enough to postpone reductions until we know.
2349 -}
2350
2351 {-
2352   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
2353   instead of qvar, we get another shift/reduce-conflict. Consider the
2354   following programs:
2355
2356      { (^^) :: Int->Int ; }          Type signature; only var allowed
2357
2358      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
2359                                      qvar allowed (because of instance decls)
2360
2361   We can't tell whether to reduce var to qvar until after we've read the signatures.
2362 -}
2363
2364 docdecl :: { LHsDecl GhcPs }
2365         : docdecld { sL1 $1 (DocD noExt (unLoc $1)) }
2366
2367 docdecld :: { LDocDecl }
2368         : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
2369         | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
2370         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
2371         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
2372
2373 decl_no_th :: { LHsDecl GhcPs }
2374         : sigdecl               { $1 }
2375
2376         | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)
2377                                             ; l = comb2 $1 $> };
2378                                         (ann, r) <- checkValDef empty SrcStrict e Nothing $3 ;
2379                                         hintBangPat (comb2 $1 $2) (unLoc e) ;
2380                                         -- Depending upon what the pattern looks like we might get either
2381                                         -- a FunBind or PatBind back from checkValDef. See Note
2382                                         -- [FunBind vs PatBind]
2383                                         case r of {
2384                                           (FunBind _ n _ _ _) ->
2385                                                 amsL l [mj AnnFunId n] >> return () ;
2386                                           (PatBind _ (dL->L l _) _rhs _) ->
2387                                                 amsL l [] >> return () } ;
2388
2389                                         _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ;
2390                                         return $! (sL l $ ValD noExt r) } }
2391
2392         | infixexp_top opt_sig rhs  {% do { (ann,r) <- checkValDef empty NoSrcStrict $1 (snd $2) $3;
2393                                         let { l = comb2 $1 $> };
2394                                         -- Depending upon what the pattern looks like we might get either
2395                                         -- a FunBind or PatBind back from checkValDef. See Note
2396                                         -- [FunBind vs PatBind]
2397                                         case r of {
2398                                           (FunBind _ n _ _ _) ->
2399                                                 amsL l (mj AnnFunId n:(fst $2)) >> return () ;
2400                                           (PatBind _ (dL->L lh _lhs) _rhs _) ->
2401                                                 amsL lh (fst $2) >> return () } ;
2402                                         _ <- amsL l (ann ++ (fst $ unLoc $3));
2403                                         return $! (sL l $ ValD noExt r) } }
2404         | pattern_synonym_decl  { $1 }
2405         | docdecl               { $1 }
2406
2407 decl    :: { LHsDecl GhcPs }
2408         : decl_no_th            { $1 }
2409
2410         -- Why do we only allow naked declaration splices in top-level
2411         -- declarations and not here? Short answer: because readFail009
2412         -- fails terribly with a panic in cvBindsAndSigs otherwise.
2413         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
2414
2415 rhs     :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
2416         : '=' exp wherebinds    { sL (comb3 $1 $2 $3)
2417                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
2418                                     ,GRHSs noExt (unguardedRHS (comb3 $1 $2 $3) $2)
2419                                    (snd $ unLoc $3)) }
2420         | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
2421                                     ,GRHSs noExt (reverse (unLoc $1))
2422                                                     (snd $ unLoc $2)) }
2423
2424 gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
2425         : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
2426         | gdrh                  { sL1 $1 [$1] }
2427
2428 gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
2429         : '|' guardquals '=' exp  {% ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
2430                                          [mj AnnVbar $1,mj AnnEqual $3] }
2431
2432 sigdecl :: { LHsDecl GhcPs }
2433         :
2434         -- See Note [Declaration/signature overlap] for why we need infixexp here
2435           infixexp_top '::' sigtypedoc
2436                         {% do { v <- checkValSigLhs $1
2437                               ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2]
2438                               ; return (sLL $1 $> $ SigD noExt $
2439                                   TypeSig noExt [v] (mkLHsSigWcType $3))} }
2440
2441         | var ',' sig_vars '::' sigtypedoc
2442            {% do { let sig = TypeSig noExt ($1 : reverse (unLoc $3))
2443                                      (mkLHsSigWcType $5)
2444                  ; addAnnotation (gl $1) AnnComma (gl $2)
2445                  ; ams ( sLL $1 $> $ SigD noExt sig )
2446                        [mu AnnDcolon $4] } }
2447
2448         | infix prec ops
2449               {% checkPrecP $2 $3 >>
2450                  ams (sLL $1 $> $ SigD noExt
2451                         (FixSig noExt (FixitySig noExt (fromOL $ unLoc $3)
2452                                 (Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1)))))
2453                      [mj AnnInfix $1,mj AnnVal $2] }
2454
2455         | pattern_synonym_sig   { sLL $1 $> . SigD noExt . unLoc $ $1 }
2456
2457         | '{-# COMPLETE' con_list opt_tyconsig  '#-}'
2458                 {% let (dcolon, tc) = $3
2459                    in ams
2460                        (sLL $1 $>
2461                          (SigD noExt (CompleteMatchSig noExt (getCOMPLETE_PRAGs $1) $2 tc)))
2462                     ([ mo $1 ] ++ dcolon ++ [mc $4]) }
2463
2464         -- This rule is for both INLINE and INLINABLE pragmas
2465         | '{-# INLINE' activation qvar '#-}'
2466                 {% ams ((sLL $1 $> $ SigD noExt (InlineSig noExt $3
2467                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
2468                                             (snd $2)))))
2469                        ((mo $1:fst $2) ++ [mc $4]) }
2470
2471         | '{-# SCC' qvar '#-}'
2472           {% ams (sLL $1 $> (SigD noExt (SCCFunSig noExt (getSCC_PRAGs $1) $2 Nothing)))
2473                  [mo $1, mc $3] }
2474
2475         | '{-# SCC' qvar STRING '#-}'
2476           {% do { scc <- getSCC $3
2477                 ; let str_lit = StringLiteral (getSTRINGs $3) scc
2478                 ; ams (sLL $1 $> (SigD noExt (SCCFunSig noExt (getSCC_PRAGs $1) $2 (Just ( sL1 $3 str_lit)))))
2479                       [mo $1, mc $4] } }
2480
2481         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
2482              {% ams (
2483                  let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
2484                                              (NoUserInline, FunLike) (snd $2)
2485                   in sLL $1 $> $ SigD noExt (SpecSig noExt $3 (fromOL $5) inl_prag))
2486                     (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
2487
2488         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
2489              {% ams (sLL $1 $> $ SigD noExt (SpecSig noExt $3 (fromOL $5)
2490                                (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
2491                                                (getSPEC_INLINE $1) (snd $2))))
2492                        (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
2493
2494         | '{-# SPECIALISE' 'instance' inst_type '#-}'
2495                 {% ams (sLL $1 $>
2496                                   $ SigD noExt (SpecInstSig noExt (getSPEC_PRAGs $1) $3))
2497                        [mo $1,mj AnnInstance $2,mc $4] }
2498
2499         -- A minimal complete definition
2500         | '{-# MINIMAL' name_boolformula_opt '#-}'
2501             {% ams (sLL $1 $> $ SigD noExt (MinimalSig noExt (getMINIMAL_PRAGs $1) $2))
2502                    [mo $1,mc $3] }
2503
2504 activation :: { ([AddAnn],Maybe Activation) }
2505         : {- empty -}                           { ([],Nothing) }
2506         | explicit_activation                   { (fst $1,Just (snd $1)) }
2507
2508 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
2509         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
2510                                   ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
2511         | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
2512                                                  ,mj AnnCloseS $4]
2513                                   ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
2514
2515 -----------------------------------------------------------------------------
2516 -- Expressions
2517
2518 quasiquote :: { Located (HsSplice GhcPs) }
2519         : TH_QUASIQUOTE   { let { loc = getLoc $1
2520                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
2521                                 ; quoterId = mkUnqual varName quoter }
2522                             in sL1 $1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2523         | TH_QQUASIQUOTE  { let { loc = getLoc $1
2524                                 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
2525                                 ; quoterId = mkQual varName (qual, quoter) }
2526                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2527
2528 exp   :: { LHsExpr GhcPs }
2529         : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig noExt $1 (mkLHsSigWcType $3))
2530                                        [mu AnnDcolon $2] }
2531         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp noExt $1 $3
2532                                                         HsFirstOrderApp True)
2533                                        [mu Annlarrowtail $2] }
2534         | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp noExt $3 $1
2535                                                       HsFirstOrderApp False)
2536                                        [mu Annrarrowtail $2] }
2537         | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp noExt $1 $3
2538                                                       HsHigherOrderApp True)
2539                                        [mu AnnLarrowtail $2] }
2540         | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp noExt $3 $1
2541                                                       HsHigherOrderApp False)
2542                                        [mu AnnRarrowtail $2] }
2543         | infixexp              { $1 }
2544
2545 infixexp :: { LHsExpr GhcPs }
2546         : exp10 { $1 }
2547         | infixexp qop exp10  {% ams (sLL $1 $> (OpApp noExt $1 $2 $3))
2548                                      [mj AnnVal $2] }
2549                  -- AnnVal annotation for NPlusKPat, which discards the operator
2550
2551 infixexp_top :: { LHsExpr GhcPs }
2552             : exp10_top               { $1 }
2553             | infixexp_top qop exp10_top
2554                                       {% do { when (srcSpanEnd (getLoc $2)
2555                                                 == srcSpanStart (getLoc $3)
2556                                                 && checkIfBang $2) $
2557                                                 warnSpaceAfterBang (comb2 $2 $3);
2558                                               ams (sLL $1 $> (OpApp noExt $1 $2 $3))
2559                                                    [mj AnnVal $2]
2560                                             }
2561                                       }
2562
2563 exp10_top :: { LHsExpr GhcPs }
2564         : '-' fexp                      {% ams (sLL $1 $> $ NegApp noExt $2 noSyntaxExpr)
2565                                                [mj AnnMinus $1] }
2566
2567
2568         | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
2569                                                                 (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2570                                       (fst $ fst $ fst $ unLoc $1) }
2571
2572         | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
2573                                               [mo $1,mj AnnVal $2
2574                                               ,mc $3] }
2575                                           -- hdaume: core annotation
2576         | fexp                         { $1 }
2577
2578 exp10 :: { LHsExpr GhcPs }
2579         : exp10_top            { $1 }
2580         | scc_annot exp        {% ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2581                                       (fst $ fst $ unLoc $1) }
2582
2583 optSemi :: { ([Located Token],Bool) }
2584         : ';'         { ([$1],True) }
2585         | {- empty -} { ([],False) }
2586
2587 scc_annot :: { Located (([AddAnn],SourceText),StringLiteral) }
2588         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
2589                                             ; return $ sLL $1 $>
2590                                                (([mo $1,mj AnnValStr $2
2591                                                 ,mc $3],getSCC_PRAGs $1),(StringLiteral (getSTRINGs $2) scc)) }
2592         | '{-# SCC' VARID  '#-}'      { sLL $1 $> (([mo $1,mj AnnVal $2
2593                                          ,mc $3],getSCC_PRAGs $1)
2594                                         ,(StringLiteral NoSourceText (getVARID $2))) }
2595
2596 hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))),
2597                          ((SourceText,SourceText),(SourceText,SourceText))
2598                        ) }
2599       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
2600                                       { sLL $1 $> $ ((([mo $1,mj AnnVal $2
2601                                               ,mj AnnVal $3,mj AnnColon $4
2602                                               ,mj AnnVal $5,mj AnnMinus $6
2603                                               ,mj AnnVal $7,mj AnnColon $8
2604                                               ,mj AnnVal $9,mc $10],
2605                                                 getGENERATED_PRAGs $1)
2606                                               ,((getStringLiteral $2)
2607                                                ,( fromInteger $ il_value $ getINTEGER $3
2608                                                 , fromInteger $ il_value $ getINTEGER $5
2609                                                 )
2610                                                ,( fromInteger $ il_value $ getINTEGER $7
2611                                                 , fromInteger $ il_value $ getINTEGER $9
2612                                                 )
2613                                                ))
2614                                              , (( getINTEGERs $3
2615                                                 , getINTEGERs $5
2616                                                 )
2617                                                ,( getINTEGERs $7
2618                                                 , getINTEGERs $9
2619                                                 )))
2620                                          }
2621
2622 fexp    :: { LHsExpr GhcPs }
2623         : fexp aexp                  {% checkBlockArguments $1 >> checkBlockArguments $2 >>
2624                                         return (sLL $1 $> $ (HsApp noExt $1 $2)) }
2625         | fexp TYPEAPP atype         {% checkBlockArguments $1 >>
2626                                         ams (sLL $1 $> $ HsAppType noExt $1 (mkHsWildCardBndrs $3))
2627                                             [mj AnnAt $2] }
2628         | 'static' aexp              {% ams (sLL $1 $> $ HsStatic noExt $2)
2629                                             [mj AnnStatic $1] }
2630         | aexp                       { $1 }
2631
2632 aexp    :: { LHsExpr GhcPs }
2633         : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat noExt $1 $3) [mj AnnAt $2] }
2634             -- If you change the parsing, make sure to understand
2635             -- Note [Lexing type applications] in Lexer.x
2636
2637         | '~' aexp              {% ams (sLL $1 $> $ ELazyPat noExt $2) [mj AnnTilde $1] }
2638
2639         | '\\' apat apats '->' exp
2640                    {% ams (sLL $1 $> $ HsLam noExt (mkMatchGroup FromSource
2641                             [sLL $1 $> $ Match { m_ext = noExt
2642                                                , m_ctxt = LambdaExpr
2643                                                , m_pats = $2:$3
2644                                                , m_grhss = unguardedGRHSs $5 }]))
2645                           [mj AnnLam $1, mu AnnRarrow $4] }
2646         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet noExt (snd $ unLoc $2) $4)
2647                                                (mj AnnLet $1:mj AnnIn $3
2648                                                  :(fst $ unLoc $2)) }
2649         | '\\' 'lcase' altslist
2650             {% ams (sLL $1 $> $ HsLamCase noExt
2651                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
2652                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
2653         | 'if' exp optSemi 'then' exp optSemi 'else' exp
2654                            {% checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
2655                               ams (sLL $1 $> $ mkHsIf $2 $5 $8)
2656                                   (mj AnnIf $1:mj AnnThen $4
2657                                      :mj AnnElse $7
2658                                      :(map (\l -> mj AnnSemi l) (fst $3))
2659                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
2660         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
2661                                            ams (sLL $1 $> $ HsMultiIf noExt
2662                                                      (reverse $ snd $ unLoc $2))
2663                                                (mj AnnIf $1:(fst $ unLoc $2)) }
2664         | 'case' exp 'of' altslist      {% ams (cL (comb3 $1 $3 $4) $
2665                                                    HsCase noExt $2 (mkMatchGroup
2666                                                    FromSource (snd $ unLoc $4)))
2667                                                (mj AnnCase $1:mj AnnOf $3
2668                                                   :(fst $ unLoc $4)) }
2669         | 'do' stmtlist              {% ams (cL (comb2 $1 $2)
2670                                                (mkHsDo DoExpr (snd $ unLoc $2)))
2671                                                (mj AnnDo $1:(fst $ unLoc $2)) }
2672         | 'mdo' stmtlist            {% ams (cL (comb2 $1 $2)
2673                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
2674                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
2675         | 'proc' aexp '->' exp
2676                        {% checkPattern empty $2 >>= \ p ->
2677                            checkCommand $4 >>= \ cmd ->
2678                            ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd))
2679                                             -- TODO: is LL right here?
2680                                [mj AnnProc $1,mu AnnRarrow $3] }
2681
2682         | aexp1                 { $1 }
2683
2684 aexp1   :: { LHsExpr GhcPs }
2685         : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
2686                                                                    (snd $3)
2687                                      ; _ <- amsL (comb2 $1 $>) (moc $2:mcc $4:(fst $3))
2688                                      ; checkRecordSyntax (sLL $1 $> r) }}
2689         | aexp2                { $1 }
2690
2691 aexp2   :: { LHsExpr GhcPs }
2692         : qvar                          { sL1 $1 (HsVar noExt   $! $1) }
2693         | qcon                          { sL1 $1 (HsVar noExt   $! $1) }
2694         | ipvar                         { sL1 $1 (HsIPVar noExt $! unLoc $1) }
2695         | overloaded_label              { sL1 $1 (HsOverLabel noExt Nothing $! unLoc $1) }
2696         | literal                       { sL1 $1 (HsLit noExt  $! unLoc $1) }
2697 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
2698 -- into HsOverLit when -foverloaded-strings is on.
2699 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
2700 --                                       (getSTRING $1) noExt) }
2701         | INTEGER   { sL (getLoc $1) (HsOverLit noExt $! mkHsIntegral   (getINTEGER $1) ) }
2702         | RATIONAL  { sL (getLoc $1) (HsOverLit noExt $! mkHsFractional (getRATIONAL $1) ) }
2703
2704         -- N.B.: sections get parsed by these next two productions.
2705         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
2706         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
2707         -- but the less cluttered version fell out of having texps.
2708         | '(' texp ')'                  {% ams (sLL $1 $> (HsPar noExt $2)) [mop $1,mcp $3] }
2709         | '(' tup_exprs ')'             {% do { e <- mkSumOrTuple Boxed (comb2 $1 $3) (snd $2)
2710                                               ; ams (sLL $1 $> e) ((mop $1:fst $2) ++ [mcp $3]) } }
2711
2712         | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple noExt [cL (gl $2)
2713                                                          (Present noExt $2)] Unboxed))
2714                                                [mo $1,mc $3] }
2715         | '(#' tup_exprs '#)'           {% do { e <- mkSumOrTuple Unboxed (comb2 $1 $3) (snd $2)
2716                                               ; ams (sLL $1 $> e) ((mo $1:fst $2) ++ [mc $3]) } }
2717
2718         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
2719         | '_'               { sL1 $1 $ EWildPat noExt }
2720
2721         -- Template Haskell Extension
2722         | splice_exp            { $1 }
2723
2724         | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2725         | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2726         | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2727         | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2728         | TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) }
2729         | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket noExt (ExpBr noExt $2))
2730                                       (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
2731                                                     else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
2732         | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket noExt (TExpBr noExt $2))
2733                                       (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
2734         | '[t|' ktype '|]'    {% ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] }
2735         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
2736                                       ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p))
2737                                           [mo $1,mu AnnCloseQ $3] }
2738         | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket noExt (DecBrL noExt (snd $2)))
2739                                       (mo $1:mu AnnCloseQ $3:fst $2) }
2740         | quasiquote          { sL1 $1 (HsSpliceE noExt (unLoc $1)) }
2741
2742         -- arrow notation extension
2743         | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm noExt $2
2744                                                            Nothing (reverse $3))
2745                                           [mu AnnOpenB $1,mu AnnCloseB $4] }
2746
2747 splice_exp :: { LHsExpr GhcPs }
2748         : splice_untyped { mapLoc (HsSpliceE noExt) $1 }
2749         | splice_typed   { mapLoc (HsSpliceE noExt) $1 }
2750
2751 splice_untyped :: { Located (HsSplice GhcPs) }
2752         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkUntypedSplice HasDollar
2753                                         (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
2754                                                            (getTH_ID_SPLICE $1)))))
2755                                        [mj AnnThIdSplice $1] }
2756         | '$(' exp ')'          {% ams (sLL $1 $> $ mkUntypedSplice HasParens $2)
2757                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
2758
2759 splice_typed :: { Located (HsSplice GhcPs) }
2760         : TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkTypedSplice HasDollar
2761                                         (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
2762                                                         (getTH_ID_TY_SPLICE $1)))))
2763                                        [mj AnnThIdTySplice $1] }
2764         | '$$(' exp ')'         {% ams (sLL $1 $> $ mkTypedSplice HasParens $2)
2765                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
2766
2767 cmdargs :: { [LHsCmdTop GhcPs] }
2768         : cmdargs acmd                  { $2 : $1 }
2769         | {- empty -}                   { [] }
2770
2771 acmd    :: { LHsCmdTop GhcPs }
2772         : aexp2                 {% checkCommand $1 >>= \ cmd ->
2773                                     return (sL1 $1 $ HsCmdTop noExt cmd) }
2774
2775 cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
2776         :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1
2777                                                   ,mj AnnCloseC $3],$2) }
2778         |      vocurly    cvtopdecls0 close    { ([],$2) }
2779
2780 cvtopdecls0 :: { [LHsDecl GhcPs] }
2781         : topdecls_semi         { cvTopDecls $1 }
2782         | topdecls              { cvTopDecls $1 }
2783
2784 -----------------------------------------------------------------------------
2785 -- Tuple expressions
2786
2787 -- "texp" is short for tuple expressions:
2788 -- things that can appear unparenthesized as long as they're
2789 -- inside parens or delimitted by commas
2790 texp :: { LHsExpr GhcPs }
2791         : exp                           { $1 }
2792
2793         -- Note [Parsing sections]
2794         -- ~~~~~~~~~~~~~~~~~~~~~~~
2795         -- We include left and right sections here, which isn't
2796         -- technically right according to the Haskell standard.
2797         -- For example (3 +, True) isn't legal.
2798         -- However, we want to parse bang patterns like
2799         --      (!x, !y)
2800         -- and it's convenient to do so here as a section
2801         -- Then when converting expr to pattern we unravel it again
2802         -- Meanwhile, the renamer checks that real sections appear
2803         -- inside parens.
2804         | infixexp qop        { sLL $1 $> $ SectionL noExt $1 $2 }
2805         | qopm infixexp       { sLL $1 $> $ SectionR noExt $1 $2 }
2806
2807        -- View patterns get parenthesized above
2808         | exp '->' texp   {% ams (sLL $1 $> $ EViewPat noExt $1 $3) [mu AnnRarrow $2] }
2809
2810 -- Always at least one comma or bar.
2811 tup_exprs :: { ([AddAnn],SumOrTuple) }
2812            : texp commas_tup_tail
2813                           {% do { addAnnotation (gl $1) AnnComma (fst $2)
2814                                 ; return ([],Tuple ((sL1 $1 (Present noExt $1)) : snd $2)) } }
2815
2816            | texp bars    { (mvbars (fst $2), Sum 1  (snd $2 + 1) $1) }
2817
2818            | commas tup_tail
2819                 {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
2820                       ; return
2821                            ([],Tuple (map (\l -> cL l missingTupArg) (fst $1) ++ $2)) } }
2822
2823            | bars texp bars0
2824                 { (mvbars (fst $1) ++ mvbars (fst $3), Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2) }
2825
2826 -- Always starts with commas; always follows an expr
2827 commas_tup_tail :: { (SrcSpan,[LHsTupArg GhcPs]) }
2828 commas_tup_tail : commas tup_tail
2829        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
2830              ; return (
2831             (head $ fst $1
2832             ,(map (\l -> cL l missingTupArg) (tail $ fst $1)) ++ $2)) } }
2833
2834 -- Always follows a comma
2835 tup_tail :: { [LHsTupArg GhcPs] }
2836           : texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
2837                                     return ((cL (gl $1) (Present noExt $1)) : snd $2) }
2838           | texp                 { [cL (gl $1) (Present noExt $1)] }
2839           | {- empty -}          { [noLoc missingTupArg] }
2840
2841 -----------------------------------------------------------------------------
2842 -- List expressions
2843
2844 -- The rules below are little bit contorted to keep lexps left-recursive while
2845 -- avoiding another shift/reduce-conflict.
2846 list :: { ([AddAnn],HsExpr GhcPs) }
2847         : texp    { ([],ExplicitList noExt Nothing [$1]) }
2848         | lexps   { ([],ExplicitList noExt Nothing (reverse (unLoc $1))) }
2849         | texp '..'             { ([mj AnnDotdot $2],
2850                                       ArithSeq noExt Nothing (From $1)) }
2851         | texp ',' exp '..'     { ([mj AnnComma $2,mj AnnDotdot $4],
2852                                   ArithSeq noExt Nothing
2853                                                              (FromThen $1 $3)) }
2854         | texp '..' exp         { ([mj AnnDotdot $2],
2855                                    ArithSeq noExt Nothing
2856                                                                (FromTo $1 $3)) }
2857         | texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
2858                                     ArithSeq noExt Nothing
2859                                                 (FromThenTo $1 $3 $5)) }
2860         | texp '|' flattenedpquals
2861              {% checkMonadComp >>= \ ctxt ->
2862                 return ([mj AnnVbar $2],
2863                         mkHsComp ctxt (unLoc $3) $1) }
2864
2865 lexps :: { Located [LHsExpr GhcPs] }
2866         : lexps ',' texp          {% addAnnotation (gl $ head $ unLoc $1)
2867                                                             AnnComma (gl $2) >>
2868                                       return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
2869         | texp ',' texp            {% addAnnotation (gl $1) AnnComma (gl $2) >>
2870                                       return (sLL $1 $> [$3,$1]) }
2871
2872 -----------------------------------------------------------------------------
2873 -- List Comprehensions
2874
2875 flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
2876     : pquals   { case (unLoc $1) of
2877                     [qs] -> sL1 $1 qs
2878                     -- We just had one thing in our "parallel" list so
2879                     -- we simply return that thing directly
2880
2881                     qss -> sL1 $1 [sL1 $1 $ ParStmt noExt [ParStmtBlock noExt qs [] noSyntaxExpr |
2882                                             qs <- qss]
2883                                             noExpr noSyntaxExpr]
2884                     -- We actually found some actual parallel lists so
2885                     -- we wrap them into as a ParStmt
2886                 }
2887
2888 pquals :: { Located [[LStmt GhcPs (LHsExpr GhcPs)]] }
2889     : squals '|' pquals
2890                      {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
2891                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
2892     | squals         { cL (getLoc $1) [reverse (unLoc $1)] }
2893
2894 squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }   -- In reverse order, because the last
2895                                         -- one can "grab" the earlier ones
2896     : squals ',' transformqual
2897              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2898                 amsL (comb2 $1 $>) (fst $ unLoc $3) >>
2899                 return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
2900     | squals ',' qual
2901              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2902                 return (sLL $1 $> ($3 : unLoc $1)) }
2903     | transformqual        {% ams $1 (fst $ unLoc $1) >>
2904                               return (sLL $1 $> [cL (getLoc $1) ((snd $ unLoc $1) [])]) }
2905     | qual                                { sL1 $1 [$1] }
2906 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
2907 --  | '{|' pquals '|}'                       { sL1 $1 [$2] }
2908
2909 -- It is possible to enable bracketing (associating) qualifier lists
2910 -- by uncommenting the lines with {| |} above. Due to a lack of
2911 -- consensus on the syntax, this feature is not being used until we
2912 -- get user demand.
2913
2914 transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
2915                         -- Function is applied to a list of stmts *in order*
2916     : 'then' exp               { sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
2917     | 'then' exp 'by' exp      { sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],\ss -> (mkTransformByStmt ss $2 $4)) }
2918     | 'then' 'group' 'using' exp
2919              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3], \ss -> (mkGroupUsingStmt ss $4)) }
2920
2921     | 'then' 'group' 'by' exp 'using' exp
2922              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5], \ss -> (mkGroupByUsingStmt ss $4 $6)) }
2923
2924 -- Note that 'group' is a special_id, which means that you can enable
2925 -- TransformListComp while still using Data.List.group. However, this
2926 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
2927 -- in by choosing the "group by" variant, which is what we want.
2928
2929 -----------------------------------------------------------------------------
2930 -- Guards
2931
2932 guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
2933     : guardquals1           { cL (getLoc $1) (reverse (unLoc $1)) }
2934
2935 guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
2936     : guardquals1 ',' qual  {% addAnnotation (gl $ head $ unLoc $1) AnnComma
2937                                              (gl $2) >>
2938                                return (sLL $1 $> ($3 : unLoc $1)) }
2939     | qual                  { sL1 $1 [$1] }
2940
2941 -----------------------------------------------------------------------------
2942 -- Case alternatives
2943
2944 altslist :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
2945         : '{'            alts '}'  { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2946                                                ,(reverse (snd $ unLoc $2))) }
2947         |     vocurly    alts  close { cL (getLoc $2) (fst $ unLoc $2
2948                                         ,(reverse (snd $ unLoc $2))) }
2949         | '{'                 '}'    { sLL $1 $> ([moc $1,mcc $2],[]) }
2950         |     vocurly          close { noLoc ([],[]) }
2951
2952 alts    :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
2953         : alts1                    { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
2954         | ';' alts                 { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
2955                                                ,snd $ unLoc $2) }
2956
2957 alts1   :: { Located ([AddAnn],[LMatch GhcPs (LHsExpr GhcPs)]) }
2958         : alts1 ';' alt         {% if null (snd $ unLoc $1)
2959                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2960                                                   ,[$3]))
2961                                      else (ams (head $ snd $ unLoc $1)
2962                                                (mj AnnSemi $2:(fst $ unLoc $1))
2963                                            >> return (sLL $1 $> ([],$3 : (snd $ unLoc $1))) ) }
2964         | alts1 ';'             {% if null (snd $ unLoc $1)
2965                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2966                                                   ,snd $ unLoc $1))
2967                                      else (ams (head $ snd $ unLoc $1)
2968                                                (mj AnnSemi $2:(fst $ unLoc $1))
2969                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
2970         | alt                   { sL1 $1 ([],[$1]) }
2971
2972 alt     :: { LMatch GhcPs (LHsExpr GhcPs) }
2973            : pat alt_rhs  {%ams (sLL $1 $> (Match { m_ext = noExt
2974                                                   , m_ctxt = CaseAlt
2975                                                   , m_pats = [$1]
2976                                                   , m_grhss = snd $ unLoc $2 }))
2977                                       (fst $ unLoc $2)}
2978
2979 alt_rhs :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
2980         : ralt wherebinds           { sLL $1 $> (fst $ unLoc $2,
2981                                             GRHSs noExt (unLoc $1) (snd $ unLoc $2)) }
2982
2983 ralt :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
2984         : '->' exp            {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
2985                                      [mu AnnRarrow $1] }
2986         | gdpats              { sL1 $1 (reverse (unLoc $1)) }
2987
2988 gdpats :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
2989         : gdpats gdpat                  { sLL $1 $> ($2 : unLoc $1) }
2990         | gdpat                         { sL1 $1 [$1] }
2991
2992 -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
2993 -- generate the open brace in addition to the vertical bar in the lexer, and
2994 -- we don't need it.
2995 ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }
2996          : '{' gdpats '}'                 { sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }
2997          |     gdpats close               { sL1 $1 ([],unLoc $1) }
2998
2999 gdpat   :: { LGRHS GhcPs (LHsExpr GhcPs) }
3000         : '|' guardquals '->' exp
3001                                   {% ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
3002                                          [mj AnnVbar $1,mu AnnRarrow $3] }
3003
3004 -- 'pat' recognises a pattern, including one with a bang at the top
3005 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
3006 -- Bangs inside are parsed as infix operator applications, so that
3007 -- we parse them right when bang-patterns are off
3008 pat     :: { LPat GhcPs }
3009 pat     :  exp          {% checkPattern empty $1 }
3010         | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR noExt
3011                                                      (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
3012                                 [mj AnnBang $1] }
3013
3014 bindpat :: { LPat GhcPs }
3015 bindpat :  exp            {% checkPattern
3016                                 (text "Possibly caused by a missing 'do'?") $1 }
3017         | '!' aexp        {% amms (checkPattern
3018                                      (text "Possibly caused by a missing 'do'?")
3019                                      (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
3020                                   [mj AnnBang $1] }
3021
3022 apat   :: { LPat GhcPs }
3023 apat    : aexp                  {% checkPattern empty $1 }
3024         | '!' aexp              {% amms (checkPattern empty
3025                                             (sLL $1 $> (SectionR noExt
3026                                                 (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
3027                                         [mj AnnBang $1] }
3028
3029 apats  :: { [LPat GhcPs] }
3030         : apat apats            { $1 : $2 }
3031         | {- empty -}           { [] }
3032
3033 -----------------------------------------------------------------------------
3034 -- Statement sequences
3035
3036 stmtlist :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)]) }
3037         : '{'           stmts '}'       { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
3038                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
3039         |     vocurly   stmts close     { cL (gl $2) (fst $ unLoc $2
3040                                                     ,reverse $ snd $ unLoc $2) }
3041
3042 --      do { ;; s ; s ; ; s ;; }
3043 -- The last Stmt should be an expression, but that's hard to enforce
3044 -- here, because we need too much lookahead if we see do { e ; }
3045 -- So we use BodyStmts throughout, and switch the last one over
3046 -- in ParseUtils.checkDo instead
3047
3048 stmts :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)]) }
3049         : stmts ';' stmt  {% if null (snd $ unLoc $1)
3050                               then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
3051                                                      ,$3 : (snd $ unLoc $1)))
3052                               else do
3053                                { ams (head $ snd $ unLoc $1) [mj AnnSemi $2]
3054                                ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(snd $ unLoc $1)) }}
3055
3056         | stmts ';'     {% if null (snd $ unLoc $1)
3057                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1),snd $ unLoc $1))
3058                              else do
3059                                { ams (head $ snd $ unLoc $1)
3060                                                [mj AnnSemi $2]
3061                                ; return $1 } }
3062         | stmt                   { sL1 $1 ([],[$1]) }
3063         | {- empty -}            { noLoc ([],[]) }
3064
3065
3066 -- For typing stmts at the GHCi prompt, where
3067 -- the input may consist of just comments.
3068 maybe_stmt :: { Maybe (LStmt GhcPs (LHsExpr GhcPs)) }
3069         : stmt                          { Just $1 }
3070         | {- nothing -}                 { Nothing }
3071
3072 stmt  :: { LStmt GhcPs (LHsExpr GhcPs) }
3073         : qual                          { $1 }
3074         | 'rec' stmtlist                {% ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
3075                                                (mj AnnRec $1:(fst $ unLoc $2)) }
3076
3077 qual  :: { LStmt GhcPs (LHsExpr GhcPs) }
3078     : bindpat '<-' exp                  {% ams (sLL $1 $> $ mkBindStmt $1 $3)
3079                                                [mu AnnLarrow $2] }
3080     | exp                               { sL1 $1 $ mkBodyStmt $1 }
3081     | 'let' binds                       {% ams (sLL $1 $>$ LetStmt noExt (snd $ unLoc $2))
3082                                                (mj AnnLet $1:(fst $ unLoc $2)) }
3083
3084 -----------------------------------------------------------------------------
3085 -- Record Field Update/Construction
3086
3087 fbinds  :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)) }
3088         : fbinds1                       { $1 }
3089         | {- empty -}                   { ([],([], Nothing)) }
3090
3091 fbinds1 :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)) }
3092         : fbind ',' fbinds1
3093                 {% addAnnotation (gl $1) AnnComma (gl $2) >>
3094                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
3095         | fbind                         { ([],([$1], Nothing)) }
3096         | '..'                          { ([mj AnnDotdot $1],([],   Just (getLoc $1))) }
3097
3098 fbind   :: { LHsRecField GhcPs (LHsExpr GhcPs) }
3099         : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
3100                                 [mj AnnEqual $2] }
3101                         -- RHS is a 'texp', allowing view patterns (Trac #6038)
3102                         -- and, incidentally, sections.  Eg
3103                         -- f (R { x = show -> s }) = ...
3104
3105         | qvar          { sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) placeHolderPunRhs True }
3106                         -- In the punning case, use a place-holder
3107                         -- The renamer fills in the final value
3108
3109 -----------------------------------------------------------------------------
3110 -- Implicit Parameter Bindings
3111
3112 dbinds  :: { Located [LIPBind GhcPs] }
3113         : dbinds ';' dbind
3114                       {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
3115                          return (let { this = $3; rest = unLoc $1 }
3116                               in rest `seq` this `seq` sLL $1 $> (this : rest)) }
3117         | dbinds ';'  {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
3118                          return (sLL $1 $> (unLoc $1)) }
3119         | dbind                        { let this = $1 in this `seq` sL1 $1 [this] }
3120 --      | {- empty -}                  { [] }
3121
3122 dbind   :: { LIPBind GhcPs }
3123 dbind   : ipvar '=' exp                {% ams (sLL $1 $> (IPBind noExt (Left $1) $3))
3124                                               [mj AnnEqual $2] }
3125
3126 ipvar   :: { Located HsIPName }
3127         : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
3128
3129 -----------------------------------------------------------------------------
3130 -- Overloaded labels
3131
3132 overloaded_label :: { Located FastString }
3133         : LABELVARID          { sL1 $1 (getLABELVARID $1) }
3134
3135 -----------------------------------------------------------------------------
3136 -- Warnings and deprecations
3137
3138 name_boolformula_opt :: { LBooleanFormula (Located RdrName) }
3139         : name_boolformula          { $1 }
3140         | {- empty -}               { noLoc mkTrue }
3141
3142 name_boolformula :: { LBooleanFormula (Located RdrName) }
3143         : name_boolformula_and                      { $1 }
3144         | name_boolformula_and '|' name_boolformula
3145                            {% aa $1 (AnnVbar, $2)
3146                               >> return (sLL $1 $> (Or [$1,$3])) }
3147
3148 name_boolformula_and :: { LBooleanFormula (Located RdrName) }
3149         : name_boolformula_and_list
3150                   { sLL (head $1) (last $1) (And ($1)) }
3151
3152 name_boolformula_and_list :: { [LBooleanFormula (Located RdrName)] }
3153         : name_boolformula_atom                               { [$1] }
3154         | name_boolformula_atom ',' name_boolformula_and_list
3155             {% aa $1 (AnnComma, $2) >> return ($1 : $3) }
3156
3157 name_boolformula_atom :: { LBooleanFormula (Located RdrName) }
3158         : '(' name_boolformula ')'  {% ams (sLL $1 $> (Parens $2)) [mop $1,mcp $3] }
3159         | name_var                  { sL1 $1 (Var $1) }
3160
3161 namelist :: { Located [Located RdrName] }
3162 namelist : name_var              { sL1 $1 [$1] }
3163          | name_var ',' namelist {% addAnnotation (gl $1) AnnComma (gl $2) >>
3164                                     return (sLL $1 $> ($1 : unLoc $3)) }
3165
3166 name_var :: { Located RdrName }
3167 name_var : var { $1 }
3168          | con { $1 }
3169
3170 -----------------------------------------
3171 -- Data constructors
3172 -- There are two different productions here as lifted list constructors
3173 -- are parsed differently.
3174
3175 qcon_nowiredlist :: { Located RdrName }
3176         : gen_qcon                     { $1 }
3177         | sysdcon_nolist               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
3178
3179 qcon :: { Located RdrName }
3180   : gen_qcon              { $1}
3181   | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
3182
3183 gen_qcon :: { Located RdrName }
3184   : qconid                { $1 }
3185   | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))
3186                                    [mop $1,mj AnnVal $2,mcp $3] }
3187
3188 con     :: { Located RdrName }
3189         : conid                 { $1 }
3190         | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))
3191                                        [mop $1,mj AnnVal $2,mcp $3] }
3192         | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
3193
3194 con_list :: { Located [Located RdrName] }
3195 con_list : con                  { sL1 $1 [$1] }
3196          | con ',' con_list     {% addAnnotation (gl $1) AnnComma (gl $2) >>
3197                                    return (sLL $1 $> ($1 : unLoc $3)) }
3198
3199 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
3200         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
3201         | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
3202                                        (mop $1:mcp $3:(mcommas (fst $2))) }
3203         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
3204         | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
3205                                        (mo $1:mc $3:(mcommas (fst $2))) }
3206
3207 sysdcon :: { Located DataCon }
3208         : sysdcon_nolist                 { $1 }
3209         | '[' ']'               {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] }
3210
3211 conop :: { Located RdrName }
3212         : consym                { $1 }
3213         | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2))
3214                                        [mj AnnBackquote $1,mj AnnVal $2
3215                                        ,mj AnnBackquote $3] }
3216
3217 qconop :: { Located RdrName }
3218         : qconsym               { $1 }
3219         | '`' qconid '`'        {% ams (sLL $1 $> (unLoc $2))
3220                                        [mj AnnBackquote $1,mj AnnVal $2
3221                                        ,mj AnnBackquote $3] }
3222
3223 ----------------------------------------------------------------------------
3224 -- Type constructors
3225
3226
3227 -- See Note [Unit tuples] in HsTypes for the distinction
3228 -- between gtycon and ntgtycon
3229 gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
3230         : ntgtycon                     { $1 }
3231         | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)
3232                                               [mop $1,mcp $2] }
3233         | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)
3234                                               [mo $1,mc $2] }
3235
3236 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
3237         : oqtycon               { $1 }
3238         | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
3239                                                         (snd $2 + 1)))
3240                                        (mop $1:mcp $3:(mcommas (fst $2))) }
3241         | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
3242                                                         (snd $2 + 1)))
3243                                        (mo $1:mc $3:(mcommas (fst $2))) }
3244         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
3245                                        [mop $1,mu AnnRarrow $2,mcp $3] }
3246         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
3247
3248 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
3249                                 -- These can appear in export lists
3250         : qtycon                        { $1 }
3251         | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2))
3252                                                [mop $1,mj AnnVal $2,mcp $3] }
3253         | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)
3254                                                [mop $1,mj AnnVal $2,mcp $3] }
3255
3256 oqtycon_no_varcon :: { Located RdrName }  -- Type constructor which cannot be mistaken
3257                                           -- for variable constructor in export lists
3258                                           -- see Note [Type constructors in export list]
3259         :  qtycon            { $1 }
3260         | '(' QCONSYM ')'    {% let { name :: Located RdrName
3261                                     ; name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2) }
3262                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
3263         | '(' CONSYM ')'     {% let { name :: Located RdrName
3264                                     ; name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2) }
3265                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
3266         | '(' ':' ')'        {% let { name :: Located RdrName
3267                                     ; name = sL1 $2 $! consDataCon_RDR }
3268                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
3269         | '(' '~' ')'        {% ams (sLL $1 $> $ eqTyCon_RDR) [mop $1,mj AnnTilde $2,mcp $3] }
3270
3271 {- Note [Type constructors in export&nbs