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