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