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