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