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