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