4bc3fa9ad041076713b5860d712b90c70709ed8d
[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                          { sLL $1 $> $ mkSpliceDecl $1 }
1068
1069 -- Type classes
1070 --
1071 cl_decl :: { LTyClDecl GhcPs }
1072         : 'class' tycl_hdr fds where_cls
1073                 {% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))
1074                         (mj AnnClass $1:(fst $ unLoc $3)++(fst $ unLoc $4)) }
1075
1076 -- Type declarations (toplevel)
1077 --
1078 ty_decl :: { LTyClDecl GhcPs }
1079            -- ordinary type synonyms
1080         : 'type' type '=' ktypedoc
1081                 -- Note ktypedoc, not sigtype, on the right of '='
1082                 -- We allow an explicit for-all but we don't insert one
1083                 -- in   type Foo a = (b,b)
1084                 -- Instead we just say b is out of scope
1085                 --
1086                 -- Note the use of type for the head; this allows
1087                 -- infix type constructors to be declared
1088                 {% amms (mkTySynonym (comb2 $1 $4) $2 $4)
1089                         [mj AnnType $1,mj AnnEqual $3] }
1090
1091            -- type family declarations
1092         | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info
1093                           where_type_family
1094                 -- Note the use of type for the head; this allows
1095                 -- infix type constructors to be declared
1096                 {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $6) $3
1097                                    (snd $ unLoc $4) (snd $ unLoc $5))
1098                         (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)
1099                            ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) }
1100
1101           -- ordinary data type or newtype declaration
1102         | data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings
1103                 {% amms (mkTyData (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
1104                            Nothing (reverse (snd $ unLoc $4))
1105                                    (fmap reverse $5))
1106                                    -- We need the location on tycl_hdr in case
1107                                    -- constrs and deriving are both empty
1108                         ((fst $ unLoc $1):(fst $ unLoc $4)) }
1109
1110           -- ordinary GADT declaration
1111         | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
1112                  gadt_constrlist
1113                  maybe_derivings
1114             {% amms (mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
1115                             (snd $ unLoc $4) (snd $ unLoc $5)
1116                             (fmap reverse $6) )
1117                                    -- We need the location on tycl_hdr in case
1118                                    -- constrs and deriving are both empty
1119                     ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
1120
1121           -- data/newtype family
1122         | 'data' 'family' type opt_datafam_kind_sig
1123                 {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3
1124                                    (snd $ unLoc $4) Nothing)
1125                         (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
1126
1127 inst_decl :: { LInstDecl GhcPs }
1128         : 'instance' overlap_pragma inst_type where_inst
1129        {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
1130              ; let cid = ClsInstDecl { cid_ext = noExt
1131                                      , cid_poly_ty = $3, cid_binds = binds
1132                                      , cid_sigs = mkClassOpSigs sigs
1133                                      , cid_tyfam_insts = ats
1134                                      , cid_overlap_mode = $2
1135                                      , cid_datafam_insts = adts }
1136              ; ams (cL (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExt, cid_inst = cid }))
1137                    (mj AnnInstance $1 : (fst $ unLoc $4)) } }
1138
1139            -- type instance declarations
1140         | 'type' 'instance' ty_fam_inst_eqn
1141                 {% ams $3 (fst $ unLoc $3)
1142                 >> amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
1143                     (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
1144
1145           -- data/newtype instance declaration
1146         | data_or_newtype 'instance' capi_ctype tycl_hdr_inst constrs
1147                           maybe_derivings
1148             {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (snd $ unLoc $4)
1149                                       Nothing (reverse (snd  $ unLoc $5))
1150                                               (fmap reverse $6))
1151                     ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $4)++(fst $ unLoc $5)) }
1152
1153           -- GADT instance declaration
1154         | data_or_newtype 'instance' capi_ctype tycl_hdr_inst opt_kind_sig
1155                  gadt_constrlist
1156                  maybe_derivings
1157             {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (snd $ unLoc $4)
1158                                    (snd $ unLoc $5) (snd $ unLoc $6)
1159                                    (fmap reverse $7))
1160                     ((fst $ unLoc $1):mj AnnInstance $2
1161                        :(fst $ unLoc $4)++(fst $ unLoc $5)++(fst $ unLoc $6)) }
1162
1163 overlap_pragma :: { Maybe (Located OverlapMode) }
1164   : '{-# OVERLAPPABLE'    '#-}' {% ajs (Just (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))))
1165                                        [mo $1,mc $2] }
1166   | '{-# OVERLAPPING'     '#-}' {% ajs (Just (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1))))
1167                                        [mo $1,mc $2] }
1168   | '{-# OVERLAPS'        '#-}' {% ajs (Just (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1))))
1169                                        [mo $1,mc $2] }
1170   | '{-# INCOHERENT'      '#-}' {% ajs (Just (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1))))
1171                                        [mo $1,mc $2] }
1172   | {- empty -}                 { Nothing }
1173
1174 deriv_strategy_no_via :: { LDerivStrategy GhcPs }
1175   : 'stock'                     {% ams (sL1 $1 StockStrategy)
1176                                        [mj AnnStock $1] }
1177   | 'anyclass'                  {% ams (sL1 $1 AnyclassStrategy)
1178                                        [mj AnnAnyclass $1] }
1179   | 'newtype'                   {% ams (sL1 $1 NewtypeStrategy)
1180                                        [mj AnnNewtype $1] }
1181
1182 deriv_strategy_via :: { LDerivStrategy GhcPs }
1183   : 'via' type              {% ams (sLL $1 $> (ViaStrategy (mkLHsSigType $2)))
1184                                             [mj AnnVia $1] }
1185
1186 deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) }
1187   : 'stock'                     {% ajs (Just (sL1 $1 StockStrategy))
1188                                        [mj AnnStock $1] }
1189   | 'anyclass'                  {% ajs (Just (sL1 $1 AnyclassStrategy))
1190                                        [mj AnnAnyclass $1] }
1191   | 'newtype'                   {% ajs (Just (sL1 $1 NewtypeStrategy))
1192                                        [mj AnnNewtype $1] }
1193   | deriv_strategy_via          { Just $1 }
1194   | {- empty -}                 { Nothing }
1195
1196 -- Injective type families
1197
1198 opt_injective_info :: { Located ([AddAnn], Maybe (LInjectivityAnn GhcPs)) }
1199         : {- empty -}               { noLoc ([], Nothing) }
1200         | '|' injectivity_cond      { sLL $1 $> ([mj AnnVbar $1]
1201                                                 , Just ($2)) }
1202
1203 injectivity_cond :: { LInjectivityAnn GhcPs }
1204         : tyvarid '->' inj_varids
1205            {% ams (sLL $1 $> (InjectivityAnn $1 (reverse (unLoc $3))))
1206                   [mu AnnRarrow $2] }
1207
1208 inj_varids :: { Located [Located RdrName] }
1209         : inj_varids tyvarid  { sLL $1 $> ($2 : unLoc $1) }
1210         | tyvarid             { sLL $1 $> [$1]            }
1211
1212 -- Closed type families
1213
1214 where_type_family :: { Located ([AddAnn],FamilyInfo GhcPs) }
1215         : {- empty -}                      { noLoc ([],OpenTypeFamily) }
1216         | 'where' ty_fam_inst_eqn_list
1217                { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1218                     ,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }
1219
1220 ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn GhcPs]) }
1221         :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ([moc $1,mcc $3]
1222                                                 ,Just (unLoc $2)) }
1223         | vocurly ty_fam_inst_eqns close   { let (dL->L loc _) = $2 in
1224                                              cL loc ([],Just (unLoc $2)) }
1225         |     '{' '..' '}'                 { sLL $1 $> ([moc $1,mj AnnDotdot $2
1226                                                  ,mcc $3],Nothing) }
1227         | vocurly '..' close               { let (dL->L loc _) = $2 in
1228                                              cL loc ([mj AnnDotdot $2],Nothing) }
1229
1230 ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] }
1231         : ty_fam_inst_eqns ';' ty_fam_inst_eqn
1232                                       {% let (dL->L loc (anns, eqn)) = $3 in
1233                                          asl (unLoc $1) $2 (cL loc eqn)
1234                                          >> ams $3 anns
1235                                          >> return (sLL $1 $> (cL loc eqn : unLoc $1)) }
1236         | ty_fam_inst_eqns ';'        {% addAnnotation (gl $1) AnnSemi (gl $2)
1237                                          >> return (sLL $1 $>  (unLoc $1)) }
1238         | ty_fam_inst_eqn             {% let (dL->L loc (anns, eqn)) = $1 in
1239                                          ams $1 anns
1240                                          >> return (sLL $1 $> [cL loc eqn]) }
1241         | {- empty -}                 { noLoc [] }
1242
1243 ty_fam_inst_eqn :: { Located ([AddAnn],TyFamInstEqn GhcPs) }
1244         : 'forall' tv_bndrs '.' type '=' ktype
1245               {% do { hintExplicitForall $1
1246                     ; (eqn,ann) <- mkTyFamInstEqn (Just $2) $4 $6
1247                     ; return (sLL $1 $>
1248                                (mu AnnForall $1:mj AnnDot $3:mj AnnEqual $5:ann,eqn)) } }
1249         | type '=' ktype
1250               {% do { (eqn,ann) <- mkTyFamInstEqn Nothing $1 $3
1251                     ; return (sLL $1 $> (mj AnnEqual $2:ann, eqn))  } }
1252               -- Note the use of type for the head; this allows
1253               -- infix type constructors and type patterns
1254
1255 -- Associated type family declarations
1256 --
1257 -- * They have a different syntax than on the toplevel (no family special
1258 --   identifier).
1259 --
1260 -- * They also need to be separate from instances; otherwise, data family
1261 --   declarations without a kind signature cause parsing conflicts with empty
1262 --   data declarations.
1263 --
1264 at_decl_cls :: { LHsDecl GhcPs }
1265         :  -- data family declarations, with optional 'family' keyword
1266           'data' opt_family type opt_datafam_kind_sig
1267                 {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
1268                                                   (snd $ unLoc $4) Nothing))
1269                         (mj AnnData $1:$2++(fst $ unLoc $4)) }
1270
1271            -- type family declarations, with optional 'family' keyword
1272            -- (can't use opt_instance because you get shift/reduce errors
1273         | 'type' type opt_at_kind_inj_sig
1274                {% amms (liftM mkTyClD
1275                         (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily $2
1276                                    (fst . snd $ unLoc $3)
1277                                    (snd . snd $ unLoc $3)))
1278                        (mj AnnType $1:(fst $ unLoc $3)) }
1279         | 'type' 'family' type opt_at_kind_inj_sig
1280                {% amms (liftM mkTyClD
1281                         (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily $3
1282                                    (fst . snd $ unLoc $4)
1283                                    (snd . snd $ unLoc $4)))
1284                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)) }
1285
1286            -- default type instances, with optional 'instance' keyword
1287         | 'type' ty_fam_inst_eqn
1288                 {% ams $2 (fst $ unLoc $2) >>
1289                    amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2)))
1290                         (mj AnnType $1:(fst $ unLoc $2)) }
1291         | 'type' 'instance' ty_fam_inst_eqn
1292                 {% ams $3 (fst $ unLoc $3) >>
1293                    amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3)))
1294                         (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
1295
1296 opt_family   :: { [AddAnn] }
1297               : {- empty -}   { [] }
1298               | 'family'      { [mj AnnFamily $1] }
1299
1300 opt_instance :: { [AddAnn] }
1301               : {- empty -} { [] }
1302               | 'instance'  { [mj AnnInstance $1] }
1303
1304 -- Associated type instances
1305 --
1306 at_decl_inst :: { LInstDecl GhcPs }
1307            -- type instance declarations, with optional 'instance' keyword
1308         : 'type' opt_instance ty_fam_inst_eqn
1309                 -- Note the use of type for the head; this allows
1310                 -- infix type constructors and type patterns
1311                 {% ams $3 (fst $ unLoc $3) >>
1312                    amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
1313                         (mj AnnType $1:$2++(fst $ unLoc $3)) }
1314
1315         -- data/newtype instance declaration, with optional 'instance' keyword
1316         -- (can't use opt_instance because you get reduce/reduce errors)
1317         | data_or_newtype capi_ctype tycl_hdr_inst constrs maybe_derivings
1318                {% amms (mkDataFamInst (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 (snd $ unLoc $3)
1319                                     Nothing (reverse (snd $ unLoc $4))
1320                                             (fmap reverse $5))
1321                        ((fst $ unLoc $1):(fst $ unLoc $3) ++ (fst $ unLoc $4)) }
1322
1323         | data_or_newtype 'instance' capi_ctype tycl_hdr_inst constrs maybe_derivings
1324                {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (snd $ unLoc $4)
1325                                     Nothing (reverse (snd $ unLoc $5))
1326                                             (fmap reverse $6))
1327                        ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $4)++(fst $ unLoc $5)) }
1328
1329         -- GADT instance declaration, with optional 'instance' keyword
1330         -- (can't use opt_instance because you get reduce/reduce errors)
1331         | data_or_newtype capi_ctype tycl_hdr_inst opt_kind_sig
1332                  gadt_constrlist
1333                  maybe_derivings
1334                 {% amms (mkDataFamInst (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2
1335                                 (snd $ unLoc $3) (snd $ unLoc $4) (snd $ unLoc $5)
1336                                 (fmap reverse $6))
1337                         ((fst $ unLoc $1):(fst $ unLoc $3)++(fst $ unLoc $4)++(fst $ unLoc $5)) }
1338
1339         | data_or_newtype 'instance' capi_ctype tycl_hdr_inst opt_kind_sig
1340                  gadt_constrlist
1341                  maybe_derivings
1342                 {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3
1343                                 (snd $ unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6)
1344                                 (fmap reverse $7))
1345                         ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $4)++(fst $ unLoc $5)++(fst $ unLoc $6)) }
1346
1347 data_or_newtype :: { Located (AddAnn, NewOrData) }
1348         : 'data'        { sL1 $1 (mj AnnData    $1,DataType) }
1349         | 'newtype'     { sL1 $1 (mj AnnNewtype $1,NewType) }
1350
1351 -- Family result/return kind signatures
1352
1353 opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind GhcPs)) }
1354         :               { noLoc     ([]               , Nothing) }
1355         | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], Just $2) }
1356
1357 opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) }
1358         :               { noLoc     ([]               , noLoc (NoSig noExt)         )}
1359         | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExt $2))}
1360
1361 opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) }
1362         :              { noLoc     ([]               , noLoc     (NoSig    noExt)   )}
1363         | '::' kind    { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig  noExt $2))}
1364         | '='  tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig noExt $2))}
1365
1366 opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig GhcPs
1367                                             , Maybe (LInjectivityAnn GhcPs)))}
1368         :            { noLoc ([], (noLoc (NoSig noExt), Nothing)) }
1369         | '::' kind  { sLL $1 $> ( [mu AnnDcolon $1]
1370                                  , (sLL $2 $> (KindSig noExt $2), Nothing)) }
1371         | '='  tv_bndr '|' injectivity_cond
1372                 { sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3]
1373                             , (sLL $1 $2 (TyVarSig noExt $2), Just $4))}
1374
1375 -- tycl_hdr parses the header of a class or data type decl,
1376 -- which takes the form
1377 --      T a b
1378 --      Eq a => T a
1379 --      (Eq a, Ord b) => T a b
1380 --      T Int [a]                       -- for associated types
1381 -- Rather a lot of inlining here, else we get reduce/reduce errors
1382 tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) }
1383         : context '=>' type         {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
1384                                        >> (return (sLL $1 $> (Just $1, $3)))
1385                                     }
1386         | type                      { sL1 $1 (Nothing, $1) }
1387
1388 tycl_hdr_inst :: { Located ([AddAnn],(Maybe (LHsContext GhcPs), Maybe [LHsTyVarBndr GhcPs], LHsType GhcPs)) }
1389         : 'forall' tv_bndrs '.' context '=>' type   {% hintExplicitForall $1
1390                                                        >> (addAnnotation (gl $4) (toUnicodeAnn AnnDarrow $5) (gl $5)
1391                                                            >> return (sLL $1 $> ([mu AnnForall $1, mj AnnDot $3]
1392                                                                                 , (Just $4, Just $2, $6)))
1393                                                           )
1394                                                     }
1395         | 'forall' tv_bndrs '.' type   {% hintExplicitForall $1
1396                                           >> return (sLL $1 $> ([mu AnnForall $1, mj AnnDot $3]
1397                                                                , (Nothing, Just $2, $4)))
1398                                        }
1399         | context '=>' type         {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
1400                                        >> (return (sLL $1 $>([], (Just $1, Nothing, $3))))
1401                                     }
1402         | type                      { sL1 $1 ([], (Nothing, Nothing, $1)) }
1403
1404
1405 capi_ctype :: { Maybe (Located CType) }
1406 capi_ctype : '{-# CTYPE' STRING STRING '#-}'
1407                        {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))
1408                                         (getSTRINGs $3,getSTRING $3))))
1409                               [mo $1,mj AnnHeader $2,mj AnnVal $3,mc $4] }
1410
1411            | '{-# CTYPE'        STRING '#-}'
1412                        {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) Nothing  (getSTRINGs $2, getSTRING $2))))
1413                               [mo $1,mj AnnVal $2,mc $3] }
1414
1415            |           { Nothing }
1416
1417 -----------------------------------------------------------------------------
1418 -- Stand-alone deriving
1419
1420 -- Glasgow extension: stand-alone deriving declarations
1421 stand_alone_deriving :: { LDerivDecl GhcPs }
1422   : 'deriving' deriv_standalone_strategy 'instance' overlap_pragma inst_type
1423                 {% do { let { err = text "in the stand-alone deriving instance"
1424                                     <> colon <+> quotes (ppr $5) }
1425                       ; ams (sLL $1 (hsSigType $>)
1426                                  (DerivDecl noExt (mkHsWildCardBndrs $5) $2 $4))
1427                             [mj AnnDeriving $1, mj AnnInstance $3] } }
1428
1429 -----------------------------------------------------------------------------
1430 -- Role annotations
1431
1432 role_annot :: { LRoleAnnotDecl GhcPs }
1433 role_annot : 'type' 'role' oqtycon maybe_roles
1434           {% amms (mkRoleAnnotDecl (comb3 $1 $3 $4) $3 (reverse (unLoc $4)))
1435                   [mj AnnType $1,mj AnnRole $2] }
1436
1437 -- Reversed!
1438 maybe_roles :: { Located [Located (Maybe FastString)] }
1439 maybe_roles : {- empty -}    { noLoc [] }
1440             | roles          { $1 }
1441
1442 roles :: { Located [Located (Maybe FastString)] }
1443 roles : role             { sLL $1 $> [$1] }
1444       | roles role       { sLL $1 $> $ $2 : unLoc $1 }
1445
1446 -- read it in as a varid for better error messages
1447 role :: { Located (Maybe FastString) }
1448 role : VARID             { sL1 $1 $ Just $ getVARID $1 }
1449      | '_'               { sL1 $1 Nothing }
1450
1451 -- Pattern synonyms
1452
1453 -- Glasgow extension: pattern synonyms
1454 pattern_synonym_decl :: { LHsDecl GhcPs }
1455         : 'pattern' pattern_synonym_lhs '=' pat
1456          {%      let (name, args,as ) = $2 in
1457                  ams (sLL $1 $> . ValD noExt $ mkPatSynBind name args $4
1458                                                     ImplicitBidirectional)
1459                (as ++ [mj AnnPattern $1, mj AnnEqual $3])
1460          }
1461
1462         | 'pattern' pattern_synonym_lhs '<-' pat
1463          {%    let (name, args, as) = $2 in
1464                ams (sLL $1 $> . ValD noExt $ mkPatSynBind name args $4 Unidirectional)
1465                (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) }
1466
1467         | 'pattern' pattern_synonym_lhs '<-' pat where_decls
1468             {% do { let (name, args, as) = $2
1469                   ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
1470                   ; ams (sLL $1 $> . ValD noExt $
1471                            mkPatSynBind name args $4 (ExplicitBidirectional mg))
1472                        (as ++ ((mj AnnPattern $1:mu AnnLarrow $3:(fst $ unLoc $5))) )
1473                    }}
1474
1475 pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName), [AddAnn]) }
1476         : con vars0 { ($1, PrefixCon $2, []) }
1477         | varid conop varid { ($2, InfixCon $1 $3, []) }
1478         | con '{' cvars1 '}' { ($1, RecCon $3, [moc $2, mcc $4] ) }
1479
1480 vars0 :: { [Located RdrName] }
1481         : {- empty -}                 { [] }
1482         | varid vars0                 { $1 : $2 }
1483
1484 cvars1 :: { [RecordPatSynField (Located RdrName)] }
1485        : var                          { [RecordPatSynField $1 $1] }
1486        | var ',' cvars1               {% addAnnotation (getLoc $1) AnnComma (getLoc $2) >>
1487                                          return ((RecordPatSynField $1 $1) : $3 )}
1488
1489 where_decls :: { Located ([AddAnn]
1490                          , Located (OrdList (LHsDecl GhcPs))) }
1491         : 'where' '{' decls '}'       { sLL $1 $> ((mj AnnWhere $1:moc $2
1492                                            :mcc $4:(fst $ unLoc $3)),sL1 $3 (snd $ unLoc $3)) }
1493         | 'where' vocurly decls close { cL (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
1494                                           ,sL1 $3 (snd $ unLoc $3)) }
1495
1496 pattern_synonym_sig :: { LSig GhcPs }
1497         : 'pattern' con_list '::' sigtypedoc
1498                    {% ams (sLL $1 $> $ PatSynSig noExt (unLoc $2) (mkLHsSigType $4))
1499                           [mj AnnPattern $1, mu AnnDcolon $3] }
1500
1501 -----------------------------------------------------------------------------
1502 -- Nested declarations
1503
1504 -- Declaration in class bodies
1505 --
1506 decl_cls  :: { LHsDecl GhcPs }
1507 decl_cls  : at_decl_cls                 { $1 }
1508           | decl                        { $1 }
1509
1510           -- A 'default' signature used with the generic-programming extension
1511           | 'default' infixexp '::' sigtypedoc
1512                     {% runExpCmdP $2 >>= \ $2 ->
1513                        do { v <- checkValSigLhs $2
1514                           ; let err = text "in default signature" <> colon <+>
1515                                       quotes (ppr $2)
1516                           ; ams (sLL $1 $> $ SigD noExt $ ClassOpSig noExt True [v] $ mkLHsSigType $4)
1517                                 [mj AnnDefault $1,mu AnnDcolon $3] } }
1518
1519 decls_cls :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) }  -- Reversed
1520           : decls_cls ';' decl_cls      {% if isNilOL (snd $ unLoc $1)
1521                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1522                                                                     , unitOL $3))
1523                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
1524                                            >> return (sLL $1 $> (fst $ unLoc $1
1525                                                                 ,(snd $ unLoc $1) `appOL` unitOL $3)) }
1526           | decls_cls ';'               {% if isNilOL (snd $ unLoc $1)
1527                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1528                                                                                    ,snd $ unLoc $1))
1529                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
1530                                            >> return (sLL $1 $>  (unLoc $1)) }
1531           | decl_cls                    { sL1 $1 ([], unitOL $1) }
1532           | {- empty -}                 { noLoc ([],nilOL) }
1533
1534 decllist_cls
1535         :: { Located ([AddAnn]
1536                      , OrdList (LHsDecl GhcPs)) }      -- Reversed
1537         : '{'         decls_cls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
1538                                              ,snd $ unLoc $2) }
1539         |     vocurly decls_cls close   { $2 }
1540
1541 -- Class body
1542 --
1543 where_cls :: { Located ([AddAnn]
1544                        ,(OrdList (LHsDecl GhcPs))) }    -- Reversed
1545                                 -- No implicit parameters
1546                                 -- May have type declarations
1547         : 'where' decllist_cls          { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1548                                              ,snd $ unLoc $2) }
1549         | {- empty -}                   { noLoc ([],nilOL) }
1550
1551 -- Declarations in instance bodies
1552 --
1553 decl_inst  :: { Located (OrdList (LHsDecl GhcPs)) }
1554 decl_inst  : at_decl_inst               { sLL $1 $> (unitOL (sL1 $1 (InstD noExt (unLoc $1)))) }
1555            | decl                       { sLL $1 $> (unitOL $1) }
1556
1557 decls_inst :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) }   -- Reversed
1558            : decls_inst ';' decl_inst   {% if isNilOL (snd $ unLoc $1)
1559                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1560                                                                     , unLoc $3))
1561                                              else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1562                                            >> return
1563                                             (sLL $1 $> (fst $ unLoc $1
1564                                                        ,(snd $ unLoc $1) `appOL` unLoc $3)) }
1565            | decls_inst ';'             {% if isNilOL (snd $ unLoc $1)
1566                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1567                                                                                    ,snd $ unLoc $1))
1568                                              else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1569                                            >> return (sLL $1 $> (unLoc $1)) }
1570            | decl_inst                  { sL1 $1 ([],unLoc $1) }
1571            | {- empty -}                { noLoc ([],nilOL) }
1572
1573 decllist_inst
1574         :: { Located ([AddAnn]
1575                      , OrdList (LHsDecl GhcPs)) }      -- Reversed
1576         : '{'         decls_inst '}'    { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) }
1577         |     vocurly decls_inst close  { cL (gl $2) (unLoc $2) }
1578
1579 -- Instance body
1580 --
1581 where_inst :: { Located ([AddAnn]
1582                         , OrdList (LHsDecl GhcPs)) }   -- Reversed
1583                                 -- No implicit parameters
1584                                 -- May have type declarations
1585         : 'where' decllist_inst         { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1586                                              ,(snd $ unLoc $2)) }
1587         | {- empty -}                   { noLoc ([],nilOL) }
1588
1589 -- Declarations in binding groups other than classes and instances
1590 --
1591 decls   :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) }
1592         : decls ';' decl    {% if isNilOL (snd $ unLoc $1)
1593                                  then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1594                                                         , unitOL $3))
1595                                  else do ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1596                                            >> return (
1597                                           let { this = unitOL $3;
1598                                                 rest = snd $ unLoc $1;
1599                                                 these = rest `appOL` this }
1600                                           in rest `seq` this `seq` these `seq`
1601                                              (sLL $1 $> (fst $ unLoc $1,these))) }
1602         | decls ';'          {% if isNilOL (snd $ unLoc $1)
1603                                   then return (sLL $1 $> ((mj AnnSemi $2:(fst $ unLoc $1)
1604                                                           ,snd $ unLoc $1)))
1605                                   else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1606                                            >> return (sLL $1 $> (unLoc $1)) }
1607         | decl                          { sL1 $1 ([], unitOL $1) }
1608         | {- empty -}                   { noLoc ([],nilOL) }
1609
1610 decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl GhcPs))) }
1611         : '{'            decls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
1612                                                    ,sL1 $2 $ snd $ unLoc $2) }
1613         |     vocurly    decls close   { cL (gl $2) (fst $ unLoc $2,sL1 $2 $ snd $ unLoc $2) }
1614
1615 -- Binding groups other than those of class and instance declarations
1616 --
1617 binds   ::  { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
1618                                          -- May have implicit parameters
1619                                                 -- No type declarations
1620         : decllist          {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)
1621                                   ; return (sL1 $1 (fst $ unLoc $1
1622                                                     ,sL1 $1 $ HsValBinds noExt val_binds)) } }
1623
1624         | '{'            dbinds '}'     { sLL $1 $> ([moc $1,mcc $3]
1625                                              ,sL1 $2 $ HsIPBinds noExt (IPBinds noExt (reverse $ unLoc $2))) }
1626
1627         |     vocurly    dbinds close   { cL (getLoc $2) ([]
1628                                             ,sL1 $2 $ HsIPBinds noExt (IPBinds noExt (reverse $ unLoc $2))) }
1629
1630
1631 wherebinds :: { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
1632                                                 -- May have implicit parameters
1633                                                 -- No type declarations
1634         : 'where' binds                 { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2)
1635                                              ,snd $ unLoc $2) }
1636         | {- empty -}                   { noLoc ([],noLoc emptyLocalBinds) }
1637
1638
1639 -----------------------------------------------------------------------------
1640 -- Transformation Rules
1641
1642 rules   :: { OrdList (LRuleDecl GhcPs) }
1643         :  rules ';' rule              {% addAnnotation (oll $1) AnnSemi (gl $2)
1644                                           >> return ($1 `snocOL` $3) }
1645         |  rules ';'                   {% addAnnotation (oll $1) AnnSemi (gl $2)
1646                                           >> return $1 }
1647         |  rule                        { unitOL $1 }
1648         |  {- empty -}                 { nilOL }
1649
1650 rule    :: { LRuleDecl GhcPs }
1651         : STRING rule_activation rule_foralls infixexp '=' exp
1652          {%runExpCmdP $4 >>= \ $4 ->
1653            runExpCmdP $6 >>= \ $6 ->
1654            ams (sLL $1 $> $ HsRule { rd_ext = noExt
1655                                    , rd_name = cL (gl $1) (getSTRINGs $1, getSTRING $1)
1656                                    , rd_act = (snd $2) `orElse` AlwaysActive
1657                                    , rd_tyvs = sndOf3 $3, rd_tmvs = thdOf3 $3
1658                                    , rd_lhs = $4, rd_rhs = $6 })
1659                (mj AnnEqual $5 : (fst $2) ++ (fstOf3 $3)) }
1660
1661 -- Rules can be specified to be NeverActive, unlike inline/specialize pragmas
1662 rule_activation :: { ([AddAnn],Maybe Activation) }
1663         : {- empty -}                           { ([],Nothing) }
1664         | rule_explicit_activation              { (fst $1,Just (snd $1)) }
1665
1666 rule_explicit_activation :: { ([AddAnn]
1667                               ,Activation) }  -- In brackets
1668         : '[' INTEGER ']'       { ([mos $1,mj AnnVal $2,mcs $3]
1669                                   ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
1670         | '[' '~' INTEGER ']'   { ([mos $1,mj AnnTilde $2,mj AnnVal $3,mcs $4]
1671                                   ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
1672         | '[' '~' ']'           { ([mos $1,mj AnnTilde $2,mcs $3]
1673                                   ,NeverActive) }
1674
1675 rule_foralls :: { ([AddAnn], Maybe [LHsTyVarBndr GhcPs], [LRuleBndr GhcPs]) }
1676         : 'forall' rule_vars '.' 'forall' rule_vars '.'    {% let tyvs = mkRuleTyVarBndrs $2
1677                                                               in hintExplicitForall $1
1678                                                               >> checkRuleTyVarBndrNames (mkRuleTyVarBndrs $2)
1679                                                               >> return ([mu AnnForall $1,mj AnnDot $3,
1680                                                                           mu AnnForall $4,mj AnnDot $6],
1681                                                                          Just (mkRuleTyVarBndrs $2), mkRuleBndrs $5) }
1682         | 'forall' rule_vars '.'                           { ([mu AnnForall $1,mj AnnDot $3],
1683                                                               Nothing, mkRuleBndrs $2) }
1684         | {- empty -}                                      { ([], Nothing, []) }
1685
1686 rule_vars :: { [LRuleTyTmVar] }
1687         : rule_var rule_vars                    { $1 : $2 }
1688         | {- empty -}                           { [] }
1689
1690 rule_var :: { LRuleTyTmVar }
1691         : varid                         { sLL $1 $> (RuleTyTmVar $1 Nothing) }
1692         | '(' varid '::' ctype ')'      {% ams (sLL $1 $> (RuleTyTmVar $2 (Just $4)))
1693                                                [mop $1,mu AnnDcolon $3,mcp $5] }
1694
1695 {- Note [Parsing explicit foralls in Rules]
1696 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1697 We really want the above definition of rule_foralls to be:
1698
1699   rule_foralls : 'forall' tv_bndrs '.' 'forall' rule_vars '.'
1700                | 'forall' rule_vars '.'
1701                | {- empty -}
1702
1703 where rule_vars (term variables) can be named "forall", "family", or "role",
1704 but tv_vars (type variables) cannot be. However, such a definition results
1705 in a reduce/reduce conflict. For example, when parsing:
1706 > {-# RULE "name" forall a ... #-}
1707 before the '...' it is impossible to determine whether we should be in the
1708 first or second case of the above.
1709
1710 This is resolved by using rule_vars (which is more general) for both, and
1711 ensuring that type-level quantified variables do not have the names "forall",
1712 "family", or "role" in the function 'checkRuleTyVarBndrNames' in RdrHsSyn.hs
1713 Thus, whenever the definition of tyvarid (used for tv_bndrs) is changed relative
1714 to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.
1715 -}
1716
1717 -----------------------------------------------------------------------------
1718 -- Warnings and deprecations (c.f. rules)
1719
1720 warnings :: { OrdList (LWarnDecl GhcPs) }
1721         : warnings ';' warning         {% addAnnotation (oll $1) AnnSemi (gl $2)
1722                                           >> return ($1 `appOL` $3) }
1723         | warnings ';'                 {% addAnnotation (oll $1) AnnSemi (gl $2)
1724                                           >> return $1 }
1725         | warning                      { $1 }
1726         | {- empty -}                  { nilOL }
1727
1728 -- SUP: TEMPORARY HACK, not checking for `module Foo'
1729 warning :: { OrdList (LWarnDecl GhcPs) }
1730         : namelist strings
1731                 {% amsu (sLL $1 $> (Warning noExt (unLoc $1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
1732                      (fst $ unLoc $2) }
1733
1734 deprecations :: { OrdList (LWarnDecl GhcPs) }
1735         : deprecations ';' deprecation
1736                                        {% addAnnotation (oll $1) AnnSemi (gl $2)
1737                                           >> return ($1 `appOL` $3) }
1738         | deprecations ';'             {% addAnnotation (oll $1) AnnSemi (gl $2)
1739                                           >> return $1 }
1740         | deprecation                  { $1 }
1741         | {- empty -}                  { nilOL }
1742
1743 -- SUP: TEMPORARY HACK, not checking for `module Foo'
1744 deprecation :: { OrdList (LWarnDecl GhcPs) }
1745         : namelist strings
1746              {% amsu (sLL $1 $> $ (Warning noExt (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
1747                      (fst $ unLoc $2) }
1748
1749 strings :: { Located ([AddAnn],[Located StringLiteral]) }
1750     : STRING { sL1 $1 ([],[cL (gl $1) (getStringLiteral $1)]) }
1751     | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) }
1752
1753 stringlist :: { Located (OrdList (Located StringLiteral)) }
1754     : stringlist ',' STRING {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
1755                                return (sLL $1 $> (unLoc $1 `snocOL`
1756                                                   (cL (gl $3) (getStringLiteral $3)))) }
1757     | STRING                { sLL $1 $> (unitOL (cL (gl $1) (getStringLiteral $1))) }
1758     | {- empty -}           { noLoc nilOL }
1759
1760 -----------------------------------------------------------------------------
1761 -- Annotations
1762 annotation :: { LHsDecl GhcPs }
1763     : '{-# ANN' name_var aexp '#-}'      {% runExpCmdP $3 >>= \ $3 ->
1764                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
1765                                             (getANN_PRAGs $1)
1766                                             (ValueAnnProvenance $2) $3))
1767                                             [mo $1,mc $4] }
1768
1769     | '{-# ANN' 'type' tycon aexp '#-}'  {% runExpCmdP $4 >>= \ $4 ->
1770                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
1771                                             (getANN_PRAGs $1)
1772                                             (TypeAnnProvenance $3) $4))
1773                                             [mo $1,mj AnnType $2,mc $5] }
1774
1775     | '{-# ANN' 'module' aexp '#-}'      {% runExpCmdP $3 >>= \ $3 ->
1776                                             ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
1777                                                 (getANN_PRAGs $1)
1778                                                  ModuleAnnProvenance $3))
1779                                                 [mo $1,mj AnnModule $2,mc $4] }
1780
1781
1782 -----------------------------------------------------------------------------
1783 -- Foreign import and export declarations
1784
1785 fdecl :: { Located ([AddAnn],HsDecl GhcPs) }
1786 fdecl : 'import' callconv safety fspec
1787                {% mkImport $2 $3 (snd $ unLoc $4) >>= \i ->
1788                  return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i))  }
1789       | 'import' callconv        fspec
1790                {% do { d <- mkImport $2 (noLoc PlaySafe) (snd $ unLoc $3);
1791                     return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $3),d)) }}
1792       | 'export' callconv fspec
1793                {% mkExport $2 (snd $ unLoc $3) >>= \i ->
1794                   return (sLL $1 $> (mj AnnExport $1 : (fst $ unLoc $3),i) ) }
1795
1796 callconv :: { Located CCallConv }
1797           : 'stdcall'                   { sLL $1 $> StdCallConv }
1798           | 'ccall'                     { sLL $1 $> CCallConv   }
1799           | 'capi'                      { sLL $1 $> CApiConv    }
1800           | 'prim'                      { sLL $1 $> PrimCallConv}
1801           | 'javascript'                { sLL $1 $> JavaScriptCallConv }
1802
1803 safety :: { Located Safety }
1804         : 'unsafe'                      { sLL $1 $> PlayRisky }
1805         | 'safe'                        { sLL $1 $> PlaySafe }
1806         | 'interruptible'               { sLL $1 $> PlayInterruptible }
1807
1808 fspec :: { Located ([AddAnn]
1809                     ,(Located StringLiteral, Located RdrName, LHsSigType GhcPs)) }
1810        : STRING var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $3]
1811                                              ,(cL (getLoc $1)
1812                                                     (getStringLiteral $1), $2, mkLHsSigType $4)) }
1813        |        var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $2]
1814                                              ,(noLoc (StringLiteral NoSourceText nilFS), $1, mkLHsSigType $3)) }
1815          -- if the entity string is missing, it defaults to the empty string;
1816          -- the meaning of an empty entity string depends on the calling
1817          -- convention
1818
1819 -----------------------------------------------------------------------------
1820 -- Type signatures
1821
1822 opt_sig :: { ([AddAnn], Maybe (LHsType GhcPs)) }
1823         : {- empty -}                   { ([],Nothing) }
1824         | '::' sigtype                  { ([mu AnnDcolon $1],Just $2) }
1825
1826 opt_tyconsig :: { ([AddAnn], Maybe (Located RdrName)) }
1827              : {- empty -}              { ([], Nothing) }
1828              | '::' gtycon              { ([mu AnnDcolon $1], Just $2) }
1829
1830 sigtype :: { LHsType GhcPs }
1831         : ctype                            { $1 }
1832
1833 sigtypedoc :: { LHsType GhcPs }
1834         : ctypedoc                         { $1 }
1835
1836
1837 sig_vars :: { Located [Located RdrName] }    -- Returned in reversed order
1838          : sig_vars ',' var           {% addAnnotation (gl $ head $ unLoc $1)
1839                                                        AnnComma (gl $2)
1840                                          >> return (sLL $1 $> ($3 : unLoc $1)) }
1841          | var                        { sL1 $1 [$1] }
1842
1843 sigtypes1 :: { (OrdList (LHsSigType GhcPs)) }
1844    : sigtype                 { unitOL (mkLHsSigType $1) }
1845    | sigtype ',' sigtypes1   {% addAnnotation (gl $1) AnnComma (gl $2)
1846                                 >> return (unitOL (mkLHsSigType $1) `appOL` $3) }
1847
1848 -----------------------------------------------------------------------------
1849 -- Types
1850
1851 unpackedness :: { Located ([AddAnn], SourceText, SrcUnpackedness) }
1852         : '{-# UNPACK' '#-}'   { sLL $1 $> ([mo $1, mc $2], getUNPACK_PRAGs $1, SrcUnpack) }
1853         | '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], getNOUNPACK_PRAGs $1, SrcNoUnpack) }
1854
1855 forall_vis_flag :: { (AddAnn, ForallVisFlag) }
1856         : '.'  { (mj AnnDot $1,    ForallInvis) }
1857         | '->' { (mj AnnRarrow $1, ForallVis)   }
1858
1859 -- A ktype/ktypedoc is a ctype/ctypedoc, possibly with a kind annotation
1860 ktype :: { LHsType GhcPs }
1861         : ctype                { $1 }
1862         | ctype '::' kind      {% ams (sLL $1 $> $ HsKindSig noExt $1 $3)
1863                                       [mu AnnDcolon $2] }
1864
1865 ktypedoc :: { LHsType GhcPs }
1866          : ctypedoc            { $1 }
1867          | ctypedoc '::' kind  {% ams (sLL $1 $> $ HsKindSig noExt $1 $3)
1868                                       [mu AnnDcolon $2] }
1869
1870 -- A ctype is a for-all type
1871 ctype   :: { LHsType GhcPs }
1872         : 'forall' tv_bndrs forall_vis_flag ctype
1873                                         {% let (fv_ann, fv_flag) = $3 in
1874                                            hintExplicitForall $1 *>
1875                                            ams (sLL $1 $> $
1876                                                 HsForAllTy { hst_fvf = fv_flag
1877                                                            , hst_bndrs = $2
1878                                                            , hst_xforall = noExt
1879                                                            , hst_body = $4 })
1880                                                [mu AnnForall $1,fv_ann] }
1881         | context '=>' ctype          {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
1882                                          >> return (sLL $1 $> $
1883                                             HsQualTy { hst_ctxt = $1
1884                                                      , hst_xqual = noExt
1885                                                      , hst_body = $3 }) }
1886         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy noExt $1 $3))
1887                                              [mu AnnDcolon $2] }
1888         | type                        { $1 }
1889
1890 -- Note [ctype and ctypedoc]
1891 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1892 -- It would have been nice to simplify the grammar by unifying `ctype` and
1893 -- ctypedoc` into one production, allowing comments on types everywhere (and
1894 -- rejecting them after parsing, where necessary).  This is however not possible
1895 -- since it leads to ambiguity. The reason is the support for comments on record
1896 -- fields:
1897 --         data R = R { field :: Int -- ^ comment on the field }
1898 -- If we allow comments on types here, it's not clear if the comment applies
1899 -- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
1900
1901 ctypedoc :: { LHsType GhcPs }
1902         : 'forall' tv_bndrs forall_vis_flag ctypedoc
1903                                          {% let (fv_ann, fv_flag) = $3 in
1904                                             hintExplicitForall $1 *>
1905                                             ams (sLL $1 $> $
1906                                                  HsForAllTy { hst_fvf = fv_flag
1907                                                             , hst_bndrs = $2
1908                                                             , hst_xforall = noExt
1909                                                             , hst_body = $4 })
1910                                                 [mu AnnForall $1,fv_ann] }
1911         | context '=>' ctypedoc       {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
1912                                          >> return (sLL $1 $> $
1913                                             HsQualTy { hst_ctxt = $1
1914                                                      , hst_xqual = noExt
1915                                                      , hst_body = $3 }) }
1916         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy noExt $1 $3))
1917                                              [mu AnnDcolon $2] }
1918         | typedoc                     { $1 }
1919
1920 ----------------------
1921 -- Notes for 'context'
1922 -- We parse a context as a btype so that we don't get reduce/reduce
1923 -- errors in ctype.  The basic problem is that
1924 --      (Eq a, Ord a)
1925 -- looks so much like a tuple type.  We can't tell until we find the =>
1926
1927 context :: { LHsContext GhcPs }
1928         :  btype                        {% do { (anns,ctx) <- checkContext $1
1929                                                 ; if null (unLoc ctx)
1930                                                    then addAnnotation (gl $1) AnnUnit (gl $1)
1931                                                    else return ()
1932                                                 ; ams ctx anns
1933                                                 } }
1934
1935 -- See Note [Constr variatons of non-terminals]
1936 constr_context :: { LHsContext GhcPs }
1937         :  constr_btype                 {% do { (anns,ctx) <- checkContext $1
1938                                                 ; if null (unLoc ctx)
1939                                                    then addAnnotation (gl $1) AnnUnit (gl $1)
1940                                                    else return ()
1941                                                 ; ams ctx anns
1942                                                 } }
1943
1944 {- Note [GADT decl discards annotations]
1945 ~~~~~~~~~~~~~~~~~~~~~
1946 The type production for
1947
1948     btype `->`         ctypedoc
1949     btype docprev `->` ctypedoc
1950
1951 add the AnnRarrow annotation twice, in different places.
1952
1953 This is because if the type is processed as usual, it belongs on the annotations
1954 for the type as a whole.
1955
1956 But if the type is passed to mkGadtDecl, it discards the top level SrcSpan, and
1957 the top-level annotation will be disconnected. Hence for this specific case it
1958 is connected to the first type too.
1959 -}
1960
1961 type :: { LHsType GhcPs }
1962         : btype                        { $1 }
1963         | btype '->' ctype             {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
1964                                        >> ams (sLL $1 $> $ HsFunTy noExt $1 $3)
1965                                               [mu AnnRarrow $2] }
1966
1967
1968 typedoc :: { LHsType GhcPs }
1969         : btype                          { $1 }
1970         | btype docprev                  { sLL $1 $> $ HsDocTy noExt $1 $2 }
1971         | docnext btype                  { sLL $1 $> $ HsDocTy noExt $2 $1 }
1972         | btype '->'     ctypedoc        {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
1973                                          >> ams (sLL $1 $> $ HsFunTy noExt $1 $3)
1974                                                 [mu AnnRarrow $2] }
1975         | btype docprev '->' ctypedoc    {% ams $1 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
1976                                          >> ams (sLL $1 $> $
1977                                                  HsFunTy noExt (cL (comb2 $1 $2)
1978                                                             (HsDocTy noExt $1 $2))
1979                                                          $4)
1980                                                 [mu AnnRarrow $3] }
1981         | docnext btype '->' ctypedoc    {% ams $2 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
1982                                          >> ams (sLL $1 $> $
1983                                                  HsFunTy noExt (cL (comb2 $1 $2)
1984                                                             (HsDocTy noExt $2 $1))
1985                                                          $4)
1986                                                 [mu AnnRarrow $3] }
1987
1988 -- See Note [Constr variatons of non-terminals]
1989 constr_btype :: { LHsType GhcPs }
1990         : constr_tyapps                 {% mergeOps (unLoc $1) }
1991
1992 -- See Note [Constr variatons of non-terminals]
1993 constr_tyapps :: { Located [Located TyEl] } -- NB: This list is reversed
1994         : constr_tyapp                  { sL1 $1 [$1] }
1995         | constr_tyapps constr_tyapp    { sLL $1 $> $ $2 : (unLoc $1) }
1996
1997 -- See Note [Constr variatons of non-terminals]
1998 constr_tyapp :: { Located TyEl }
1999         : tyapp                         { $1 }
2000         | docprev                       { sL1 $1 $ TyElDocPrev (unLoc $1) }
2001
2002 btype :: { LHsType GhcPs }
2003         : tyapps                        {% mergeOps $1 }
2004
2005 tyapps :: { [Located TyEl] } -- NB: This list is reversed
2006         : tyapp                         { [$1] }
2007         | tyapps tyapp                  { $2 : $1 }
2008
2009 tyapp :: { Located TyEl }
2010         : atype                         { sL1 $1 $ TyElOpd (unLoc $1) }
2011         | TYPEAPP atype                 { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) }
2012         | qtyconop                      { sL1 $1 $ if isBangRdr (unLoc $1) then TyElBang else
2013                                                    if isTildeRdr (unLoc $1) then TyElTilde else
2014                                                    TyElOpr (unLoc $1) }
2015         | tyvarop                       { sL1 $1 $ TyElOpr (unLoc $1) }
2016         | SIMPLEQUOTE qconop            {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
2017                                                [mj AnnSimpleQuote $1,mj AnnVal $2] }
2018         | SIMPLEQUOTE varop             {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
2019                                                [mj AnnSimpleQuote $1,mj AnnVal $2] }
2020         | unpackedness                  { sL1 $1 $ TyElUnpackedness (unLoc $1) }
2021
2022 atype :: { LHsType GhcPs }
2023         : ntgtycon                       { sL1 $1 (HsTyVar noExt NotPromoted $1) }      -- Not including unit tuples
2024         | tyvar                          { sL1 $1 (HsTyVar noExt NotPromoted $1) }      -- (See Note [Unit tuples])
2025         | '*'                            {% do { warnStarIsType (getLoc $1)
2026                                                ; return $ sL1 $1 (HsStarTy noExt (isUnicode $1)) } }
2027         | '{' fielddecls '}'             {% amms (checkRecordSyntax
2028                                                     (sLL $1 $> $ HsRecTy noExt $2))
2029                                                         -- Constructor sigs only
2030                                                  [moc $1,mcc $3] }
2031         | '(' ')'                        {% ams (sLL $1 $> $ HsTupleTy noExt
2032                                                     HsBoxedOrConstraintTuple [])
2033                                                 [mop $1,mcp $2] }
2034         | '(' ktype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
2035                                                           (gl $3) >>
2036                                             ams (sLL $1 $> $ HsTupleTy noExt
2037
2038                                              HsBoxedOrConstraintTuple ($2 : $4))
2039                                                 [mop $1,mcp $5] }
2040         | '(#' '#)'                   {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple [])
2041                                              [mo $1,mc $2] }
2042         | '(#' comma_types1 '#)'      {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple $2)
2043                                              [mo $1,mc $3] }
2044         | '(#' bar_types2 '#)'        {% ams (sLL $1 $> $ HsSumTy noExt $2)
2045                                              [mo $1,mc $3] }
2046         | '[' ktype ']'               {% ams (sLL $1 $> $ HsListTy  noExt $2) [mos $1,mcs $3] }
2047         | '(' ktype ')'               {% ams (sLL $1 $> $ HsParTy   noExt $2) [mop $1,mcp $3] }
2048         | quasiquote                  { mapLoc (HsSpliceTy noExt) $1 }
2049         | splice_untyped              { mapLoc (HsSpliceTy noExt) $1 }
2050                                       -- see Note [Promotion] for the followings
2051         | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
2052         | SIMPLEQUOTE  '(' ktype ',' comma_types1 ')'
2053                              {% addAnnotation (gl $3) AnnComma (gl $4) >>
2054                                 ams (sLL $1 $> $ HsExplicitTupleTy noExt ($3 : $5))
2055                                     [mj AnnSimpleQuote $1,mop $2,mcp $6] }
2056         | SIMPLEQUOTE  '[' comma_types0 ']'     {% ams (sLL $1 $> $ HsExplicitListTy noExt IsPromoted $3)
2057                                                        [mj AnnSimpleQuote $1,mos $2,mcs $4] }
2058         | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2)
2059                                                        [mj AnnSimpleQuote $1,mj AnnName $2] }
2060
2061         -- Two or more [ty, ty, ty] must be a promoted list type, just as
2062         -- if you had written '[ty, ty, ty]
2063         -- (One means a list type, zero means the list type constructor,
2064         -- so you have to quote those.)
2065         | '[' ktype ',' comma_types1 ']'  {% addAnnotation (gl $2) AnnComma
2066                                                            (gl $3) >>
2067                                              ams (sLL $1 $> $ HsExplicitListTy noExt NotPromoted ($2 : $4))
2068                                                  [mos $1,mcs $5] }
2069         | INTEGER              { sLL $1 $> $ HsTyLit noExt $ HsNumTy (getINTEGERs $1)
2070                                                            (il_value (getINTEGER $1)) }
2071         | STRING               { sLL $1 $> $ HsTyLit noExt $ HsStrTy (getSTRINGs $1)
2072                                                                      (getSTRING  $1) }
2073         | '_'                  { sL1 $1 $ mkAnonWildCardTy }
2074
2075 -- An inst_type is what occurs in the head of an instance decl
2076 --      e.g.  (Foo a, Gaz b) => Wibble a b
2077 -- It's kept as a single type for convenience.
2078 inst_type :: { LHsSigType GhcPs }
2079         : sigtype                       { mkLHsSigType $1 }
2080
2081 deriv_types :: { [LHsSigType GhcPs] }
2082         : typedoc                       { [mkLHsSigType $1] }
2083
2084         | typedoc ',' deriv_types       {% addAnnotation (gl $1) AnnComma (gl $2)
2085                                            >> return (mkLHsSigType $1 : $3) }
2086
2087 comma_types0  :: { [LHsType GhcPs] }  -- Zero or more:  ty,ty,ty
2088         : comma_types1                  { $1 }
2089         | {- empty -}                   { [] }
2090
2091 comma_types1    :: { [LHsType GhcPs] }  -- One or more:  ty,ty,ty
2092         : ktype                        { [$1] }
2093         | ktype  ',' comma_types1      {% addAnnotation (gl $1) AnnComma (gl $2)
2094                                           >> return ($1 : $3) }
2095
2096 bar_types2    :: { [LHsType GhcPs] }  -- Two or more:  ty|ty|ty
2097         : ktype  '|' ktype             {% addAnnotation (gl $1) AnnVbar (gl $2)
2098                                           >> return [$1,$3] }
2099         | ktype  '|' bar_types2        {% addAnnotation (gl $1) AnnVbar (gl $2)
2100                                           >> return ($1 : $3) }
2101
2102 tv_bndrs :: { [LHsTyVarBndr GhcPs] }
2103          : tv_bndr tv_bndrs             { $1 : $2 }
2104          | {- empty -}                  { [] }
2105
2106 tv_bndr :: { LHsTyVarBndr GhcPs }
2107         : tyvar                         { sL1 $1 (UserTyVar noExt $1) }
2108         | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar noExt $2 $4))
2109                                                [mop $1,mu AnnDcolon $3
2110                                                ,mcp $5] }
2111
2112 fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
2113         : {- empty -}                   { noLoc ([],[]) }
2114         | '|' fds1                      { (sLL $1 $> ([mj AnnVbar $1]
2115                                                  ,reverse (unLoc $2))) }
2116
2117 fds1 :: { Located [Located (FunDep (Located RdrName))] }
2118         : fds1 ',' fd   {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2)
2119                            >> return (sLL $1 $> ($3 : unLoc $1)) }
2120         | fd            { sL1 $1 [$1] }
2121
2122 fd :: { Located (FunDep (Located RdrName)) }
2123         : varids0 '->' varids0  {% ams (cL (comb3 $1 $2 $3)
2124                                        (reverse (unLoc $1), reverse (unLoc $3)))
2125                                        [mu AnnRarrow $2] }
2126
2127 varids0 :: { Located [Located RdrName] }
2128         : {- empty -}                   { noLoc [] }
2129         | varids0 tyvar                 { sLL $1 $> ($2 : unLoc $1) }
2130
2131 -----------------------------------------------------------------------------
2132 -- Kinds
2133
2134 kind :: { LHsKind GhcPs }
2135         : ctype                  { $1 }
2136
2137 {- Note [Promotion]
2138    ~~~~~~~~~~~~~~~~
2139
2140 - Syntax of promoted qualified names
2141 We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
2142 names. Moreover ticks are only allowed in types, not in kinds, for a
2143 few reasons:
2144   1. we don't need quotes since we cannot define names in kinds
2145   2. if one day we merge types and kinds, tick would mean look in DataName
2146   3. we don't have a kind namespace anyway
2147
2148 - Name resolution
2149 When the user write Zero instead of 'Zero in types, we parse it a
2150 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
2151 deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
2152 bounded in the type level, then we look for it in the term level (we
2153 change its namespace to DataName, see Note [Demotion] in OccName). And
2154 both become a HsTyVar ("Zero", DataName) after the renamer.
2155
2156 -}
2157
2158
2159 -----------------------------------------------------------------------------
2160 -- Datatype declarations
2161
2162 gadt_constrlist :: { Located ([AddAnn]
2163                           ,[LConDecl GhcPs]) } -- Returned in order
2164
2165         : 'where' '{'        gadt_constrs '}'    {% checkEmptyGADTs $
2166                                                       cL (comb2 $1 $3)
2167                                                         ([mj AnnWhere $1
2168                                                          ,moc $2
2169                                                          ,mcc $4]
2170                                                         , unLoc $3) }
2171         | 'where' vocurly    gadt_constrs close  {% checkEmptyGADTs $
2172                                                       cL (comb2 $1 $3)
2173                                                         ([mj AnnWhere $1]
2174                                                         , unLoc $3) }
2175         | {- empty -}                            { noLoc ([],[]) }
2176
2177 gadt_constrs :: { Located [LConDecl GhcPs] }
2178         : gadt_constr_with_doc ';' gadt_constrs
2179                   {% addAnnotation (gl $1) AnnSemi (gl $2)
2180                      >> return (cL (comb2 $1 $3) ($1 : unLoc $3)) }
2181         | gadt_constr_with_doc          { cL (gl $1) [$1] }
2182         | {- empty -}                   { noLoc [] }
2183
2184 -- We allow the following forms:
2185 --      C :: Eq a => a -> T a
2186 --      C :: forall a. Eq a => !a -> T a
2187 --      D { x,y :: a } :: T a
2188 --      forall a. Eq a => D { x,y :: a } :: T a
2189
2190 gadt_constr_with_doc :: { LConDecl GhcPs }
2191 gadt_constr_with_doc
2192         : maybe_docnext ';' gadt_constr
2193                 {% return $ addConDoc $3 $1 }
2194         | gadt_constr
2195                 {% return $1 }
2196
2197 gadt_constr :: { LConDecl GhcPs }
2198     -- see Note [Difference in parsing GADT and data constructors]
2199     -- Returns a list because of:   C,D :: ty
2200         : con_list '::' sigtypedoc
2201                 {% let (gadt,anns) = mkGadtDecl (unLoc $1) $3
2202                    in ams (sLL $1 $> gadt)
2203                        (mu AnnDcolon $2:anns) }
2204
2205 {- Note [Difference in parsing GADT and data constructors]
2206 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2207 GADT constructors have simpler syntax than usual data constructors:
2208 in GADTs, types cannot occur to the left of '::', so they cannot be mixed
2209 with constructor names (see Note [Parsing data constructors is hard]).
2210
2211 Due to simplified syntax, GADT constructor names (left-hand side of '::')
2212 use simpler grammar production than usual data constructor names. As a
2213 consequence, GADT constructor names are resticted (names like '(*)' are
2214 allowed in usual data constructors, but not in GADTs).
2215 -}
2216
2217 constrs :: { Located ([AddAnn],[LConDecl GhcPs]) }
2218         : maybe_docnext '=' constrs1    { cL (comb2 $2 $3) ([mj AnnEqual $2]
2219                                                      ,addConDocs (unLoc $3) $1)}
2220
2221 constrs1 :: { Located [LConDecl GhcPs] }
2222         : constrs1 maybe_docnext '|' maybe_docprev constr
2223             {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
2224                >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
2225         | constr                                          { sL1 $1 [$1] }
2226
2227 {- Note [Constr variatons of non-terminals]
2228 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2229
2230 In record declarations we assume that 'ctype' used to parse the type will not
2231 consume the trailing docprev:
2232
2233   data R = R { field :: Int -- ^ comment on the field }
2234
2235 In 'R' we expect the comment to apply to the entire field, not to 'Int'. The
2236 same issue is detailed in Note [ctype and ctypedoc].
2237
2238 So, we do not want 'ctype'  to consume 'docprev', therefore
2239     we do not want 'btype'  to consume 'docprev', therefore
2240     we do not want 'tyapps' to consume 'docprev'.
2241
2242 At the same time, when parsing a 'constr', we do want to consume 'docprev':
2243
2244   data T = C Int  -- ^ comment on Int
2245              Bool -- ^ comment on Bool
2246
2247 So, we do want 'constr_stuff' to consume 'docprev'.
2248
2249 The problem arises because the clauses in 'constr' have the following
2250 structure:
2251
2252   (a)  context '=>' constr_stuff   (e.g.  data T a = Ord a => C a)
2253   (b)               constr_stuff   (e.g.  data T a =          C a)
2254
2255 and to avoid a reduce/reduce conflict, 'context' and 'constr_stuff' must be
2256 compatible. And for 'context' to be compatible with 'constr_stuff', it must
2257 consume 'docprev'.
2258
2259 So, we want 'context'  to consume 'docprev', therefore
2260     we want 'btype'    to consume 'docprev', therefore
2261     we want 'tyapps'   to consume 'docprev'.
2262
2263 Our requirements end up conflicting: for parsing record types, we want 'tyapps'
2264 to leave 'docprev' alone, but for parsing constructors, we want it to consume
2265 'docprev'.
2266
2267 As the result, we maintain two parallel hierarchies of non-terminals that
2268 either consume 'docprev' or not:
2269
2270   tyapps      constr_tyapps
2271   btype       constr_btype
2272   context     constr_context
2273   ...
2274
2275 They must be kept identical except for their treatment of 'docprev'.
2276
2277 -}
2278
2279 constr :: { LConDecl GhcPs }
2280         : maybe_docnext forall constr_context '=>' constr_stuff
2281                 {% ams (let (con,details,doc_prev) = unLoc $5 in
2282                   addConDoc (cL (comb4 $2 $3 $4 $5) (mkConDeclH98 con
2283                                                        (snd $ unLoc $2)
2284                                                        (Just $3)
2285                                                        details))
2286                             ($1 `mplus` doc_prev))
2287                         (mu AnnDarrow $4:(fst $ unLoc $2)) }
2288         | maybe_docnext forall constr_stuff
2289                 {% ams ( let (con,details,doc_prev) = unLoc $3 in
2290                   addConDoc (cL (comb2 $2 $3) (mkConDeclH98 con
2291                                                       (snd $ unLoc $2)
2292                                                       Nothing   -- No context
2293                                                       details))
2294                             ($1 `mplus` doc_prev))
2295                        (fst $ unLoc $2) }
2296
2297 forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr GhcPs]) }
2298         : 'forall' tv_bndrs '.'       { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }
2299         | {- empty -}                 { noLoc ([], Nothing) }
2300
2301 constr_stuff :: { Located (Located RdrName, HsConDeclDetails GhcPs, Maybe LHsDocString) }
2302         : constr_tyapps                    {% do { c <- mergeDataCon (unLoc $1)
2303                                                  ; return $ sL1 $1 c } }
2304
2305 fielddecls :: { [LConDeclField GhcPs] }
2306         : {- empty -}     { [] }
2307         | fielddecls1     { $1 }
2308
2309 fielddecls1 :: { [LConDeclField GhcPs] }
2310         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
2311             {% addAnnotation (gl $1) AnnComma (gl $3) >>
2312                return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
2313         | fielddecl   { [$1] }
2314
2315 fielddecl :: { LConDeclField GhcPs }
2316                                               -- A list because of   f,g :: Int
2317         : maybe_docnext sig_vars '::' ctype maybe_docprev
2318             {% ams (cL (comb2 $2 $4)
2319                       (ConDeclField noExt (reverse (map (\ln@(dL->L l n) -> cL l $ FieldOcc noExt ln) (unLoc $2))) $4 ($1 `mplus` $5)))
2320                    [mu AnnDcolon $3] }
2321
2322 -- Reversed!
2323 maybe_derivings :: { HsDeriving GhcPs }
2324         : {- empty -}             { noLoc [] }
2325         | derivings               { $1 }
2326
2327 -- A list of one or more deriving clauses at the end of a datatype
2328 derivings :: { HsDeriving GhcPs }
2329         : derivings deriving      { sLL $1 $> $ $2 : unLoc $1 }
2330         | deriving                { sLL $1 $> [$1] }
2331
2332 -- The outer Located is just to allow the caller to
2333 -- know the rightmost extremity of the 'deriving' clause
2334 deriving :: { LHsDerivingClause GhcPs }
2335         : 'deriving' deriv_clause_types
2336               {% let { full_loc = comb2 $1 $> }
2337                  in ams (cL full_loc $ HsDerivingClause noExt Nothing $2)
2338                         [mj AnnDeriving $1] }
2339
2340         | 'deriving' deriv_strategy_no_via deriv_clause_types
2341               {% let { full_loc = comb2 $1 $> }
2342                  in ams (cL full_loc $ HsDerivingClause noExt (Just $2) $3)
2343                         [mj AnnDeriving $1] }
2344
2345         | 'deriving' deriv_clause_types deriv_strategy_via
2346               {% let { full_loc = comb2 $1 $> }
2347                  in ams (cL full_loc $ HsDerivingClause noExt (Just $3) $2)
2348                         [mj AnnDeriving $1] }
2349
2350 deriv_clause_types :: { Located [LHsSigType GhcPs] }
2351         : qtycondoc           { sL1 $1 [mkLHsSigType $1] }
2352         | '(' ')'             {% ams (sLL $1 $> [])
2353                                      [mop $1,mcp $2] }
2354         | '(' deriv_types ')' {% ams (sLL $1 $> $2)
2355                                      [mop $1,mcp $3] }
2356              -- Glasgow extension: allow partial
2357              -- applications in derivings
2358
2359 -----------------------------------------------------------------------------
2360 -- Value definitions
2361
2362 {- Note [Declaration/signature overlap]
2363 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2364 There's an awkward overlap with a type signature.  Consider
2365         f :: Int -> Int = ...rhs...
2366    Then we can't tell whether it's a type signature or a value
2367    definition with a result signature until we see the '='.
2368    So we have to inline enough to postpone reductions until we know.
2369 -}
2370
2371 {-
2372   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
2373   instead of qvar, we get another shift/reduce-conflict. Consider the
2374   following programs:
2375
2376      { (^^) :: Int->Int ; }          Type signature; only var allowed
2377
2378      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
2379                                      qvar allowed (because of instance decls)
2380
2381   We can't tell whether to reduce var to qvar until after we've read the signatures.
2382 -}
2383
2384 docdecl :: { LHsDecl GhcPs }
2385         : docdecld { sL1 $1 (DocD noExt (unLoc $1)) }
2386
2387 docdecld :: { LDocDecl }
2388         : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
2389         | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
2390         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
2391         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
2392
2393 decl_no_th :: { LHsDecl GhcPs }
2394         : sigdecl               { $1 }
2395
2396         | '!' aexp rhs          {% runExpCmdP $2 >>= \ $2 ->
2397                                    do { let { e = sLL $1 $2 (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)
2398                                             ; l = comb2 $1 $> };
2399                                         (ann, r) <- checkValDef SrcStrict e Nothing $3 ;
2400                                         runPV $ hintBangPat (comb2 $1 $2) (unLoc e) ;
2401                                         -- Depending upon what the pattern looks like we might get either
2402                                         -- a FunBind or PatBind back from checkValDef. See Note
2403                                         -- [FunBind vs PatBind]
2404                                         case r of {
2405                                           (FunBind _ n _ _ _) ->
2406                                                 amsL l [mj AnnFunId n] >> return () ;
2407                                           (PatBind _ (dL->L l _) _rhs _) ->
2408                                                 amsL l [] >> return () } ;
2409
2410                                         _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ;
2411                                         return $! (sL l $ ValD noExt r) } }
2412
2413         | infixexp_top opt_sig rhs  {% do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3;
2414                                         let { l = comb2 $1 $> };
2415                                         -- Depending upon what the pattern looks like we might get either
2416                                         -- a FunBind or PatBind back from checkValDef. See Note
2417                                         -- [FunBind vs PatBind]
2418                                         case r of {
2419                                           (FunBind _ n _ _ _) ->
2420                                                 amsL l (mj AnnFunId n:(fst $2)) >> return () ;
2421                                           (PatBind _ (dL->L lh _lhs) _rhs _) ->
2422                                                 amsL lh (fst $2) >> return () } ;
2423                                         _ <- amsL l (ann ++ (fst $ unLoc $3));
2424                                         return $! (sL l $ ValD noExt r) } }
2425         | pattern_synonym_decl  { $1 }
2426         | docdecl               { $1 }
2427
2428 decl    :: { LHsDecl GhcPs }
2429         : decl_no_th            { $1 }
2430
2431         -- Why do we only allow naked declaration splices in top-level
2432         -- declarations and not here? Short answer: because readFail009
2433         -- fails terribly with a panic in cvBindsAndSigs otherwise.
2434         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
2435
2436 rhs     :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
2437         : '=' exp wherebinds    {% runExpCmdP $2 >>= \ $2 -> return $
2438                                   sL (comb3 $1 $2 $3)
2439                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
2440                                     ,GRHSs noExt (unguardedRHS (comb3 $1 $2 $3) $2)
2441                                    (snd $ unLoc $3)) }
2442         | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
2443                                     ,GRHSs noExt (reverse (unLoc $1))
2444                                                     (snd $ unLoc $2)) }
2445
2446 gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
2447         : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
2448         | gdrh                  { sL1 $1 [$1] }
2449
2450 gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
2451         : '|' guardquals '=' exp  {% runExpCmdP $4 >>= \ $4 ->
2452                                      ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
2453                                          [mj AnnVbar $1,mj AnnEqual $3] }
2454
2455 sigdecl :: { LHsDecl GhcPs }
2456         :
2457         -- See Note [Declaration/signature overlap] for why we need infixexp here
2458           infixexp_top '::' sigtypedoc
2459                         {% do { v <- checkValSigLhs $1
2460                               ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2]
2461                               ; return (sLL $1 $> $ SigD noExt $
2462                                   TypeSig noExt [v] (mkLHsSigWcType $3))} }
2463
2464         | var ',' sig_vars '::' sigtypedoc
2465            {% do { let sig = TypeSig noExt ($1 : reverse (unLoc $3))
2466                                      (mkLHsSigWcType $5)
2467                  ; addAnnotation (gl $1) AnnComma (gl $2)
2468                  ; ams ( sLL $1 $> $ SigD noExt sig )
2469                        [mu AnnDcolon $4] } }
2470
2471         | infix prec ops
2472               {% checkPrecP $2 $3 >>
2473                  ams (sLL $1 $> $ SigD noExt
2474                         (FixSig noExt (FixitySig noExt (fromOL $ unLoc $3)
2475                                 (Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1)))))
2476                      [mj AnnInfix $1,mj AnnVal $2] }
2477
2478         | pattern_synonym_sig   { sLL $1 $> . SigD noExt . unLoc $ $1 }
2479
2480         | '{-# COMPLETE' con_list opt_tyconsig  '#-}'
2481                 {% let (dcolon, tc) = $3
2482                    in ams
2483                        (sLL $1 $>
2484                          (SigD noExt (CompleteMatchSig noExt (getCOMPLETE_PRAGs $1) $2 tc)))
2485                     ([ mo $1 ] ++ dcolon ++ [mc $4]) }
2486
2487         -- This rule is for both INLINE and INLINABLE pragmas
2488         | '{-# INLINE' activation qvar '#-}'
2489                 {% ams ((sLL $1 $> $ SigD noExt (InlineSig noExt $3
2490                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
2491                                             (snd $2)))))
2492                        ((mo $1:fst $2) ++ [mc $4]) }
2493
2494         | '{-# SCC' qvar '#-}'
2495           {% ams (sLL $1 $> (SigD noExt (SCCFunSig noExt (getSCC_PRAGs $1) $2 Nothing)))
2496                  [mo $1, mc $3] }
2497
2498         | '{-# SCC' qvar STRING '#-}'
2499           {% do { scc <- getSCC $3
2500                 ; let str_lit = StringLiteral (getSTRINGs $3) scc
2501                 ; ams (sLL $1 $> (SigD noExt (SCCFunSig noExt (getSCC_PRAGs $1) $2 (Just ( sL1 $3 str_lit)))))
2502                       [mo $1, mc $4] } }
2503
2504         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
2505              {% ams (
2506                  let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
2507                                              (NoUserInline, FunLike) (snd $2)
2508                   in sLL $1 $> $ SigD noExt (SpecSig noExt $3 (fromOL $5) inl_prag))
2509                     (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
2510
2511         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
2512              {% ams (sLL $1 $> $ SigD noExt (SpecSig noExt $3 (fromOL $5)
2513                                (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
2514                                                (getSPEC_INLINE $1) (snd $2))))
2515                        (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
2516
2517         | '{-# SPECIALISE' 'instance' inst_type '#-}'
2518                 {% ams (sLL $1 $>
2519                                   $ SigD noExt (SpecInstSig noExt (getSPEC_PRAGs $1) $3))
2520                        [mo $1,mj AnnInstance $2,mc $4] }
2521
2522         -- A minimal complete definition
2523         | '{-# MINIMAL' name_boolformula_opt '#-}'
2524             {% ams (sLL $1 $> $ SigD noExt (MinimalSig noExt (getMINIMAL_PRAGs $1) $2))
2525                    [mo $1,mc $3] }
2526
2527 activation :: { ([AddAnn],Maybe Activation) }
2528         : {- empty -}                           { ([],Nothing) }
2529         | explicit_activation                   { (fst $1,Just (snd $1)) }
2530
2531 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
2532         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
2533                                   ,ActiveAfter  (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
2534         | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
2535                                                  ,mj AnnCloseS $4]
2536                                   ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
2537
2538 -----------------------------------------------------------------------------
2539 -- Expressions
2540
2541 quasiquote :: { Located (HsSplice GhcPs) }
2542         : TH_QUASIQUOTE   { let { loc = getLoc $1
2543                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
2544                                 ; quoterId = mkUnqual varName quoter }
2545                             in sL1 $1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2546         | TH_QQUASIQUOTE  { let { loc = getLoc $1
2547                                 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
2548                                 ; quoterId = mkQual varName (qual, quoter) }
2549                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2550
2551 exp   :: { ExpCmdP }
2552         : infixexp '::' sigtype {% runExpCmdP $1 >>= \ $1 ->
2553                                    fmap ecFromExp $
2554                                    ams (sLL $1 $> $ ExprWithTySig noExt $1 (mkLHsSigWcType $3))
2555                                        [mu AnnDcolon $2] }
2556         | infixexp '-<' exp     {% runExpCmdP $1 >>= \ $1 ->
2557                                    runExpCmdP $3 >>= \ $3 ->
2558                                    fmap ecFromCmd $
2559                                    ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3
2560                                                         HsFirstOrderApp True)
2561                                        [mu Annlarrowtail $2] }
2562         | infixexp '>-' exp     {% runExpCmdP $1 >>= \ $1 ->
2563                                    runExpCmdP $3 >>= \ $3 ->
2564                                    fmap ecFromCmd $
2565                                    ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1
2566                                                       HsFirstOrderApp False)
2567                                        [mu Annrarrowtail $2] }
2568         | infixexp '-<<' exp    {% runExpCmdP $1 >>= \ $1 ->
2569                                    runExpCmdP $3 >>= \ $3 ->
2570                                    fmap ecFromCmd $
2571                                    ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3
2572                                                       HsHigherOrderApp True)
2573                                        [mu AnnLarrowtail $2] }
2574         | infixexp '>>-' exp    {% runExpCmdP $1 >>= \ $1 ->
2575                                    runExpCmdP $3 >>= \ $3 ->
2576                                    fmap ecFromCmd $
2577                                    ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1
2578                                                       HsHigherOrderApp False)
2579                                        [mu AnnRarrowtail $2] }
2580         | infixexp              { $1 }
2581
2582 infixexp :: { ExpCmdP }
2583         : exp10 { $1 }
2584         | infixexp qop exp10  {  ExpCmdP $
2585                                  runExpCmdPV $1 >>= \ $1 ->
2586                                  runExpCmdPV $3 >>= \ $3 ->
2587                                  ams (sLL $1 $> (ecOpApp $1 $2 $3))
2588                                      [mj AnnVal $2] }
2589                  -- AnnVal annotation for NPlusKPat, which discards the operator
2590
2591 infixexp_top :: { LHsExpr GhcPs }
2592             : exp10_top               {% runExpCmdP $1 }
2593             | infixexp_top qop exp10_top
2594                                       {% runExpCmdP $3 >>= \ $3 ->
2595                                          do { when (srcSpanEnd (getLoc $2)
2596                                                 == srcSpanStart (getLoc $3)
2597                                                 && checkIfBang $2) $
2598                                                 warnSpaceAfterBang (comb2 $2 $3);
2599                                               ams (sLL $1 $> (OpApp noExt $1 $2 $3))
2600                                                    [mj AnnVal $2]
2601                                             }
2602                                       }
2603
2604 exp10_top :: { ExpCmdP }
2605         : '-' fexp                      {% runExpCmdP $2 >>= \ $2 ->
2606                                            fmap ecFromExp $
2607                                            ams (sLL $1 $> $ NegApp noExt $2 noSyntaxExpr)
2608                                                [mj AnnMinus $1] }
2609
2610
2611         | hpc_annot exp        {% runExpCmdP $2 >>= \ $2 ->
2612                                   fmap ecFromExp $
2613                                   ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
2614                                                                 (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2615                                       (fst $ fst $ fst $ unLoc $1) }
2616
2617         | '{-# CORE' STRING '#-}' exp  {% runExpCmdP $4 >>= \ $4 ->
2618                                           fmap ecFromExp $
2619                                           ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
2620                                               [mo $1,mj AnnVal $2
2621                                               ,mc $3] }
2622                                           -- hdaume: core annotation
2623         | fexp                         { $1 }
2624
2625 exp10 :: { ExpCmdP }
2626         : exp10_top            { $1 }
2627         | scc_annot exp        {% runExpCmdP $2 >>= \ $2 ->
2628                                   fmap ecFromExp $
2629                                   ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2630                                       (fst $ fst $ unLoc $1) }
2631
2632 optSemi :: { ([Located Token],Bool) }
2633         : ';'         { ([$1],True) }
2634         | {- empty -} { ([],False) }
2635
2636 scc_annot :: { Located (([AddAnn],SourceText),StringLiteral) }
2637         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
2638                                             ; return $ sLL $1 $>
2639                                                (([mo $1,mj AnnValStr $2
2640                                                 ,mc $3],getSCC_PRAGs $1),(StringLiteral (getSTRINGs $2) scc)) }
2641         | '{-# SCC' VARID  '#-}'      { sLL $1 $> (([mo $1,mj AnnVal $2
2642                                          ,mc $3],getSCC_PRAGs $1)
2643                                         ,(StringLiteral NoSourceText (getVARID $2))) }
2644
2645 hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))),
2646                          ((SourceText,SourceText),(SourceText,SourceText))
2647                        ) }
2648       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
2649                                       { sLL $1 $> $ ((([mo $1,mj AnnVal $2
2650                                               ,mj AnnVal $3,mj AnnColon $4
2651                                               ,mj AnnVal $5,mj AnnMinus $6
2652                                               ,mj AnnVal $7,mj AnnColon $8
2653                                               ,mj AnnVal $9,mc $10],
2654                                                 getGENERATED_PRAGs $1)
2655                                               ,((getStringLiteral $2)
2656                                                ,( fromInteger $ il_value $ getINTEGER $3
2657                                                 , fromInteger $ il_value $ getINTEGER $5
2658                                                 )
2659                                                ,( fromInteger $ il_value $ getINTEGER $7
2660                                                 , fromInteger $ il_value $ getINTEGER $9
2661                                                 )
2662                                                ))
2663                                              , (( getINTEGERs $3
2664                                                 , getINTEGERs $5
2665                                                 )
2666                                                ,( getINTEGERs $7
2667                                                 , getINTEGERs $9
2668                                                 )))
2669                                          }
2670
2671 fexp    :: { ExpCmdP }
2672         : fexp aexp                  {% runExpCmdP $2 >>= \ $2 ->
2673                                         runPV (checkBlockArguments $2) >>= \_ ->
2674                                         return $ ExpCmdP $
2675                                           runExpCmdPV $1 >>= \ $1 ->
2676                                           checkBlockArguments $1 >>= \_ ->
2677                                           return (sLL $1 $> (ecHsApp $1 $2)) }
2678         | fexp TYPEAPP atype         {% runExpCmdP $1 >>= \ $1 ->
2679                                         runPV (checkBlockArguments $1) >>= \_ ->
2680                                         fmap ecFromExp $
2681                                         ams (sLL $1 $> $ HsAppType noExt $1 (mkHsWildCardBndrs $3))
2682                                             [mj AnnAt $2] }
2683         | 'static' aexp              {% runExpCmdP $2 >>= \ $2 ->
2684                                         fmap ecFromExp $
2685                                         ams (sLL $1 $> $ HsStatic noExt $2)
2686                                             [mj AnnStatic $1] }
2687         | aexp                       { $1 }
2688
2689 aexp    :: { ExpCmdP }
2690         : qvar '@' aexp         {% runExpCmdP $3 >>= \ $3 ->
2691                                    fmap ecFromExp $
2692                                    ams (sLL $1 $> $ EAsPat noExt $1 $3) [mj AnnAt $2] }
2693             -- If you change the parsing, make sure to understand
2694             -- Note [Lexing type applications] in Lexer.x
2695
2696         | '~' aexp              {% runExpCmdP $2 >>= \ $2 ->
2697                                    fmap ecFromExp $
2698                                    ams (sLL $1 $> $ ELazyPat noExt $2) [mj AnnTilde $1] }
2699
2700         | '\\' apat apats '->' exp
2701                    {  ExpCmdP $
2702                       runExpCmdPV $5 >>= \ $5 ->
2703                       ams (sLL $1 $> $ ecHsLam (mkMatchGroup FromSource
2704                             [sLL $1 $> $ Match { m_ext = noExt
2705                                                , m_ctxt = LambdaExpr
2706                                                , m_pats = $2:$3
2707                                                , m_grhss = unguardedGRHSs $5 }]))
2708                           [mj AnnLam $1, mu AnnRarrow $4] }
2709         | 'let' binds 'in' exp          {  ExpCmdP $
2710                                            runExpCmdPV $4 >>= \ $4 ->
2711                                            ams (sLL $1 $> $ ecHsLet (snd (unLoc $2)) $4)
2712                                                (mj AnnLet $1:mj AnnIn $3
2713                                                  :(fst $ unLoc $2)) }
2714         | '\\' 'lcase' altslist
2715             {% runPV $3 >>= \ $3 ->
2716                fmap ecFromExp $
2717                ams (sLL $1 $> $ HsLamCase noExt
2718                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
2719                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
2720         | 'if' exp optSemi 'then' exp optSemi 'else' exp
2721                          {% runExpCmdP $2 >>= \ $2 ->
2722                             return $ ExpCmdP $
2723                               runExpCmdPV $5 >>= \ $5 ->
2724                               runExpCmdPV $8 >>= \ $8 ->
2725                               checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
2726                               ams (sLL $1 $> $ ecHsIf $2 $5 $8)
2727                                   (mj AnnIf $1:mj AnnThen $4
2728                                      :mj AnnElse $7
2729                                      :(map (\l -> mj AnnSemi l) (fst $3))
2730                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
2731         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>= \_ ->
2732                                            fmap ecFromExp $
2733                                            ams (sLL $1 $> $ HsMultiIf noExt
2734                                                      (reverse $ snd $ unLoc $2))
2735                                                (mj AnnIf $1:(fst $ unLoc $2)) }
2736         | 'case' exp 'of' altslist    {% runExpCmdP $2 >>= \ $2 ->
2737                                          return $ ExpCmdP $
2738                                            $4 >>= \ $4 ->
2739                                            ams (cL (comb3 $1 $3 $4) $
2740                                                    ecHsCase $2 (mkMatchGroup
2741                                                    FromSource (snd $ unLoc $4)))
2742                                                (mj AnnCase $1:mj AnnOf $3
2743                                                   :(fst $ unLoc $4)) }
2744         | 'do' stmtlist              { ExpCmdP $
2745                                         $2 >>= \ $2 ->
2746                                         ams (cL (comb2 $1 $2)
2747                                                (ecHsDo (mapLoc snd $2)))
2748                                                (mj AnnDo $1:(fst $ unLoc $2)) }
2749         | 'mdo' stmtlist            {% runPV $2 >>= \ $2 ->
2750                                        fmap ecFromExp $
2751                                        ams (cL (comb2 $1 $2)
2752                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
2753                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
2754         | 'proc' aexp '->' exp
2755                        {% (checkPattern <=< runExpCmdP) $2 >>= \ p ->
2756                            runExpCmdP $4 >>= \ $4@cmd ->
2757                            fmap ecFromExp $
2758                            ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd))
2759                                             -- TODO: is LL right here?
2760                                [mj AnnProc $1,mu AnnRarrow $3] }
2761
2762         | aexp1                 { $1 }
2763
2764 aexp1   :: { ExpCmdP }
2765         : aexp1 '{' fbinds '}' {% runExpCmdP $1 >>= \ $1 ->
2766                                   do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
2767                                                                    (snd $3)
2768                                      ; _ <- amsL (comb2 $1 $>) (moc $2:mcc $4:(fst $3))
2769                                      ; fmap ecFromExp $
2770                                        checkRecordSyntax (sLL $1 $> r) }}
2771         | aexp2                { $1 }
2772
2773 aexp2   :: { ExpCmdP }
2774         : qvar                          { ecFromExp $ sL1 $1 (HsVar noExt   $! $1) }
2775         | qcon                          { ecFromExp $ sL1 $1 (HsVar noExt   $! $1) }
2776         | ipvar                         { ecFromExp $ sL1 $1 (HsIPVar noExt $! unLoc $1) }
2777         | overloaded_label              { ecFromExp $ sL1 $1 (HsOverLabel noExt Nothing $! unLoc $1) }
2778         | literal                       { ecFromExp $ sL1 $1 (HsLit noExt  $! unLoc $1) }
2779 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
2780 -- into HsOverLit when -foverloaded-strings is on.
2781 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
2782 --                                       (getSTRING $1) noExt) }
2783         | INTEGER   { ecFromExp $ sL (getLoc $1) (HsOverLit noExt $! mkHsIntegral   (getINTEGER $1) ) }
2784         | RATIONAL  { ecFromExp $ sL (getLoc $1) (HsOverLit noExt $! mkHsFractional (getRATIONAL $1) ) }
2785
2786         -- N.B.: sections get parsed by these next two productions.
2787         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
2788         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
2789         -- but the less cluttered version fell out of having texps.
2790         | '(' texp ')'                  { ExpCmdP $
2791                                            runExpCmdPV $2 >>= \ $2 ->
2792                                            ams (sLL $1 $> (ecHsPar $2)) [mop $1,mcp $3] }
2793         | '(' tup_exprs ')'             {% do { e <- mkSumOrTuple Boxed (comb2 $1 $3) (snd $2)
2794                                               ; fmap ecFromExp $
2795                                                 ams (sLL $1 $> e) ((mop $1:fst $2) ++ [mcp $3]) } }
2796
2797         | '(#' texp '#)'                {% runExpCmdP $2 >>= \ $2 ->
2798                                            fmap ecFromExp $
2799                                            ams (sLL $1 $> (ExplicitTuple noExt [cL (gl $2)
2800                                                          (Present noExt $2)] Unboxed))
2801                                                [mo $1,mc $3] }
2802         | '(#' tup_exprs '#)'           {% do { e <- mkSumOrTuple Unboxed (comb2 $1 $3) (snd $2)
2803                                               ; fmap ecFromExp $
2804                                                 ams (sLL $1 $> e) ((mo $1:fst $2) ++ [mc $3]) } }
2805
2806         | '[' list ']'      {% fmap ecFromExp $ ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
2807         | '_'               { ecFromExp $ sL1 $1 $ EWildPat noExt }
2808
2809         -- Template Haskell Extension
2810         | splice_exp            { ecFromExp $1 }
2811
2812         | SIMPLEQUOTE  qvar     {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2813         | SIMPLEQUOTE  qcon     {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2814         | TH_TY_QUOTE tyvar     {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2815         | TH_TY_QUOTE gtycon    {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2816         | TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) }
2817         | '[|' exp '|]'       {% runExpCmdP $2 >>= \ $2 ->
2818                                  fmap ecFromExp $
2819                                  ams (sLL $1 $> $ HsBracket noExt (ExpBr noExt $2))
2820                                       (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
2821                                                     else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
2822         | '[||' exp '||]'     {% runExpCmdP $2 >>= \ $2 ->
2823                                  fmap ecFromExp $
2824                                  ams (sLL $1 $> $ HsBracket noExt (TExpBr noExt $2))
2825                                       (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
2826         | '[t|' ktype '|]'    {% fmap ecFromExp $
2827                                  ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] }
2828         | '[p|' infixexp '|]' {% (checkPattern <=< runExpCmdP) $2 >>= \p ->
2829                                       fmap ecFromExp $
2830                                       ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p))
2831                                           [mo $1,mu AnnCloseQ $3] }
2832         | '[d|' cvtopbody '|]' {% fmap ecFromExp $
2833                                   ams (sLL $1 $> $ HsBracket noExt (DecBrL noExt (snd $2)))
2834                                       (mo $1:mu AnnCloseQ $3:fst $2) }
2835         | quasiquote          { ecFromExp $ sL1 $1 (HsSpliceE noExt (unLoc $1)) }
2836
2837         -- arrow notation extension
2838         | '(|' aexp2 cmdargs '|)'  {% runExpCmdP $2 >>= \ $2 ->
2839                                       fmap ecFromCmd $
2840                                       ams (sLL $1 $> $ HsCmdArrForm noExt $2 Prefix
2841                                                            Nothing (reverse $3))
2842                                           [mu AnnOpenB $1,mu AnnCloseB $4] }
2843
2844 splice_exp :: { LHsExpr GhcPs }
2845         : splice_untyped { mapLoc (HsSpliceE noExt) $1 }
2846         | splice_typed   { mapLoc (HsSpliceE noExt) $1 }
2847
2848 splice_untyped :: { Located (HsSplice GhcPs) }
2849         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkUntypedSplice HasDollar
2850                                         (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
2851                                                            (getTH_ID_SPLICE $1)))))
2852                                        [mj AnnThIdSplice $1] }
2853         | '$(' exp ')'          {% runExpCmdP $2 >>= \ $2 ->
2854                                    ams (sLL $1 $> $ mkUntypedSplice HasParens $2)
2855                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
2856
2857 splice_typed :: { Located (HsSplice GhcPs) }
2858         : TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkTypedSplice HasDollar
2859                                         (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
2860                                                         (getTH_ID_TY_SPLICE $1)))))
2861                                        [mj AnnThIdTySplice $1] }
2862         | '$$(' exp ')'         {% runExpCmdP $2 >>= \ $2 ->
2863                                     ams (sLL $1 $> $ mkTypedSplice HasParens $2)
2864                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
2865
2866 cmdargs :: { [LHsCmdTop GhcPs] }
2867         : cmdargs acmd                  { $2 : $1 }
2868         | {- empty -}                   { [] }
2869
2870 acmd    :: { LHsCmdTop GhcPs }
2871         : aexp2                 {% runExpCmdP $1 >>= \ cmd ->
2872                                     return (sL1 cmd $ HsCmdTop noExt cmd) }
2873
2874 cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
2875         :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1
2876                                                   ,mj AnnCloseC $3],$2) }
2877         |      vocurly    cvtopdecls0 close    { ([],$2) }
2878
2879 cvtopdecls0 :: { [LHsDecl GhcPs] }
2880         : topdecls_semi         { cvTopDecls $1 }
2881         | topdecls              { cvTopDecls $1 }
2882
2883 -----------------------------------------------------------------------------
2884 -- Tuple expressions
2885
2886 -- "texp" is short for tuple expressions:
2887 -- things that can appear unparenthesized as long as they're
2888 -- inside parens or delimitted by commas
2889 texp :: { ExpCmdP }
2890         : exp                           { $1 }
2891
2892         -- Note [Parsing sections]
2893         -- ~~~~~~~~~~~~~~~~~~~~~~~
2894         -- We include left and right sections here, which isn't
2895         -- technically right according to the Haskell standard.
2896         -- For example (3 +, True) isn't legal.
2897         -- However, we want to parse bang patterns like
2898         --      (!x, !y)
2899         -- and it's convenient to do so here as a section
2900         -- Then when converting expr to pattern we unravel it again
2901         -- Meanwhile, the renamer checks that real sections appear
2902         -- inside parens.
2903         | infixexp qop       {% runExpCmdP $1 >>= \ $1 ->
2904                                 return $ ecFromExp $
2905                                 sLL $1 $> $ SectionL noExt $1 $2 }
2906         | qopm infixexp      {% runExpCmdP $2 >>= \ $2 ->
2907                                 return $ ecFromExp $
2908                                 sLL $1 $> $ SectionR noExt $1 $2 }
2909
2910        -- View patterns get parenthesized above
2911         | exp '->' texp   {% runExpCmdP $1 >>= \ $1 ->
2912                              runExpCmdP $3 >>= \ $3 ->
2913                              fmap ecFromExp $
2914                              ams (sLL $1 $> $ EViewPat noExt $1 $3) [mu AnnRarrow $2] }
2915
2916 -- Always at least one comma or bar.
2917 tup_exprs :: { ([AddAnn],SumOrTuple) }
2918            : texp commas_tup_tail
2919                           {% runExpCmdP $1 >>= \ $1 ->
2920                              do { addAnnotation (gl $1) AnnComma (fst $2)
2921                                 ; return ([],Tuple ((sL1 $1 (Present noExt $1)) : snd $2)) } }
2922
2923            | texp bars   {% runExpCmdP $1 >>= \ $1 -> return $
2924                             (mvbars (fst $2), Sum 1  (snd $2 + 1) $1) }
2925
2926            | commas tup_tail
2927                 {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
2928                       ; return
2929                            ([],Tuple (map (\l -> cL l missingTupArg) (fst $1) ++ $2)) } }
2930
2931            | bars texp bars0
2932                 {% runExpCmdP $2 >>= \ $2 -> return $
2933                   (mvbars (fst $1) ++ mvbars (fst $3), Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2) }
2934
2935 -- Always starts with commas; always follows an expr
2936 commas_tup_tail :: { (SrcSpan,[LHsTupArg GhcPs]) }
2937 commas_tup_tail : commas tup_tail
2938        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
2939              ; return (
2940             (head $ fst $1
2941             ,(map (\l -> cL l missingTupArg) (tail $ fst $1)) ++ $2)) } }
2942
2943 -- Always follows a comma
2944 tup_tail :: { [LHsTupArg GhcPs] }
2945           : texp commas_tup_tail {% runExpCmdP $1 >>= \ $1 ->
2946                                     addAnnotation (gl $1) AnnComma (fst $2) >>
2947                                     return ((cL (gl $1) (Present noExt $1)) : snd $2) }
2948           | texp                 {% runExpCmdP $1 >>= \ $1 ->
2949                                     return [cL (gl $1) (Present noExt $1)] }
2950           | {- empty -}          { [noLoc missingTupArg] }
2951
2952 -----------------------------------------------------------------------------
2953 -- List expressions
2954
2955 -- The rules below are little bit contorted to keep lexps left-recursive while
2956 -- avoiding another shift/reduce-conflict.
2957 list :: { ([AddAnn],HsExpr GhcPs) }
2958         : texp    {% runExpCmdP $1 >>= \ $1 ->
2959                      return ([],ExplicitList noExt Nothing [$1]) }
2960         | lexps   { ([],ExplicitList noExt Nothing (reverse (unLoc $1))) }
2961         | texp '..'             {% runExpCmdP $1 >>= \ $1 ->
2962                                   return ([mj AnnDotdot $2],
2963                                       ArithSeq noExt Nothing (From $1)) }
2964         | texp ',' exp '..'     {% runExpCmdP $1 >>= \ $1 ->
2965                                    runExpCmdP $3 >>= \ $3 ->
2966                                   return ([mj AnnComma $2,mj AnnDotdot $4],
2967                                   ArithSeq noExt Nothing
2968                                                              (FromThen $1 $3)) }
2969         | texp '..' exp         {% runExpCmdP $1 >>= \ $1 ->
2970                                    runExpCmdP $3 >>= \ $3 ->
2971                                   return ([mj AnnDotdot $2],
2972                                    ArithSeq noExt Nothing
2973                                                                (FromTo $1 $3)) }
2974         | texp ',' exp '..' exp {% runExpCmdP $1 >>= \ $1 ->
2975                                    runExpCmdP $3 >>= \ $3 ->
2976                                    runExpCmdP $5 >>= \ $5 ->
2977                                   return ([mj AnnComma $2,mj AnnDotdot $4],
2978                                     ArithSeq noExt Nothing
2979                                                 (FromThenTo $1 $3 $5)) }
2980         | texp '|' flattenedpquals
2981              {% checkMonadComp >>= \ ctxt ->
2982                 runExpCmdP $1 >>= \ $1 ->
2983                 return ([mj AnnVbar $2],
2984                         mkHsComp ctxt (unLoc $3) $1) }
2985
2986 lexps :: { Located [LHsExpr GhcPs] }
2987         : lexps ',' texp          {% runExpCmdP $3 >>= \ $3 ->
2988                                      addAnnotation (gl $ head $ unLoc $1)
2989                                                             AnnComma (gl $2) >>
2990                                       return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
2991         | texp ',' texp            {% runExpCmdP $1 >>= \ $1 ->
2992                                       runExpCmdP $3 >>= \ $3 ->
2993                                       addAnnotation (gl $1) AnnComma (gl $2) >>
2994                                       return (sLL $1 $> [$3,$1]) }
2995
2996 -----------------------------------------------------------------------------
2997 -- List Comprehensions
2998
2999 flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
3000     : pquals   { case (unLoc $1) of
3001                     [qs] -> sL1 $1 qs
3002                     -- We just had one thing in our "parallel" list so
3003                     -- we simply return that thing directly
3004
3005                     qss -> sL1 $1 [sL1 $1 $ ParStmt noExt [ParStmtBlock noExt qs [] noSyntaxExpr |
3006                                             qs <- qss]
3007                                             noExpr noSyntaxExpr]
3008                     -- We actually found some actual parallel lists so
3009                     -- we wrap them into as a ParStmt
3010                 }
3011
3012 pquals :: { Located [[LStmt GhcPs (LHsExpr GhcPs)]] }
3013     : squals '|' pquals
3014                      {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
3015                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
3016     | squals         { cL (getLoc $1) [reverse (unLoc $1)] }
3017
3018 squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }   -- In reverse order, because the last
3019                                         -- one can "grab" the earlier ones
3020     : squals ',' transformqual
3021              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
3022                 amsL (comb2 $1 $>) (fst $ unLoc $3) >>
3023                 return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
3024     | squals ',' qual
3025              {% runPV $3 >>= \ $3 ->
3026                 addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
3027                 return (sLL $1 $> ($3 : unLoc $1)) }
3028     | transformqual        {% ams $1 (fst $ unLoc $1) >>
3029                               return (sLL $1 $> [cL (getLoc $1) ((snd $ unLoc $1) [])]) }
3030     | qual                               {% runPV $1 >>= \ $1 ->
3031                                             return $ sL1 $1 [$1] }
3032 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
3033 --  | '{|' pquals '|}'                       { sL1 $1 [$2] }
3034
3035 -- It is possible to enable bracketing (associating) qualifier lists
3036 -- by uncommenting the lines with {| |} above. Due to a lack of
3037 -- consensus on the syntax, this feature is not being used until we
3038 -- get user demand.
3039
3040 transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
3041                         -- Function is applied to a list of stmts *in order*
3042     : 'then' exp              {% runExpCmdP $2 >>= \ $2 -> return $
3043                                  sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
3044     | 'then' exp 'by' exp     {% runExpCmdP $2 >>= \ $2 ->
3045                                  runExpCmdP $4 >>= \ $4 ->
3046                                  return $ sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],
3047                                                      \ss -> (mkTransformByStmt ss $2 $4)) }
3048     | 'then' 'group' 'using' exp
3049             {% runExpCmdP $4 >>= \ $4 ->
3050                return $ sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3],
3051                                    \ss -> (mkGroupUsingStmt ss $4)) }
3052
3053     | 'then' 'group' 'by' exp 'using' exp
3054             {% runExpCmdP $4 >>= \ $4 ->
3055                runExpCmdP $6 >>= \ $6 ->
3056                return $ sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5],
3057                                    \ss -> (mkGroupByUsingStmt ss $4 $6)) }
3058
3059 -- Note that 'group' is a special_id, which means that you can enable
3060 -- TransformListComp while still using Data.List.group. However, this
3061 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
3062 -- in by choosing the "group by" variant, which is what we want.
3063
3064 -----------------------------------------------------------------------------
3065 -- Guards
3066
3067 guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
3068     : guardquals1           { cL (getLoc $1) (reverse (unLoc $1)) }
3069
3070 guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
3071     : guardquals1 ',' qual  {% runPV $3 >>= \ $3 ->
3072                                addAnnotation (gl $ head $ unLoc $1) AnnComma
3073                                              (gl $2) >>
3074                                return (sLL $1 $> ($3 : unLoc $1)) }
3075     | qual                  {% runPV $1 >>= \ $1 ->
3076                                return $ sL1 $1 [$1] }
3077
3078 -----------------------------------------------------------------------------
3079 -- Case alternatives
3080
3081 altslist :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
3082         : '{'            alts '}'  { $2 >>= \ $2 -> return $
3083                                      sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
3084                                                ,(reverse (snd $ unLoc $2))) }
3085         |     vocurly    alts  close { $2 >>= \ $2 -> return $
3086                                        cL (getLoc $2) (fst $ unLoc $2
3087                                         ,(reverse (snd $ unLoc $2))) }
3088         | '{'                 '}'    { return $ sLL $1 $> ([moc $1,mcc $2],[]) }
3089         |     vocurly          close { return $ noLoc ([],[]) }
3090
3091 alts    :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
3092         : alts1                    { $1 >>= \ $1 -> return $
3093                                      sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
3094         | ';' alts                 { $2 >>= \ $2 -> return $
3095                                      sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
3096                                                ,snd $ unLoc $2) }
3097
3098 alts1   :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LMatch GhcPs (Located (b GhcPs))])) }
3099         : alts1 ';' alt         { $1 >>= \ $1 ->
3100                                   $3 >>= \ $3 ->
3101                                      if null (snd $ unLoc $1)
3102                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
3103                                                   ,[$3]))
3104                                      else (ams (head $ snd $ unLoc $1)
3105                                                (mj AnnSemi $2:(fst $ unLoc $1))
3106                                            >> return (sLL $1 $> ([],$3 : (snd $ unLoc $1))) ) }
3107         | alts1 ';'             {  $1 >>= \ $1 ->
3108                                    if null (snd $ unLoc $1)
3109                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
3110                                                   ,snd $ unLoc $1))
3111                                      else (ams (head $ snd $ unLoc $1)
3112                                                (mj AnnSemi $2:(fst $ unLoc $1))
3113                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
3114         | alt                   { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) }
3115
3116 alt     :: { forall b. ExpCmdI b => PV (LMatch GhcPs (Located (b GhcPs))) }
3117            : pat alt_rhs  { $2 >>= \ $2 ->
3118                             ams (sLL $1 $> (Match { m_ext = noExt
3119                                                   , m_ctxt = CaseAlt
3120                                                   , m_pats = [$1]
3121                                                   , m_grhss = snd $ unLoc $2 }))
3122                                       (fst $ unLoc $2)}
3123
3124 alt_rhs :: { forall b. ExpCmdI b => PV (Located ([AddAnn],GRHSs GhcPs (Located (b GhcPs)))) }
3125         : ralt wherebinds           { $1 >>= \alt ->
3126                                       return $ sLL alt $> (fst $ unLoc $2, GRHSs noExt (unLoc alt) (snd $ unLoc $2)) }
3127
3128 ralt :: { forall b. ExpCmdI b => PV (Located [LGRHS GhcPs (Located (b GhcPs))]) }
3129         : '->' exp            { runExpCmdPV $2 >>= \ $2 ->
3130                                 ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
3131                                     [mu AnnRarrow $1] }
3132         | gdpats              { $1 >>= \gdpats ->
3133                                 return $ sL1 gdpats (reverse (unLoc gdpats)) }
3134
3135 gdpats :: { forall b. ExpCmdI b => PV (Located [LGRHS GhcPs (Located (b GhcPs))]) }
3136         : gdpats gdpat { $1 >>= \gdpats ->
3137                          $2 >>= \gdpat ->
3138                          return $ sLL gdpats gdpat (gdpat : unLoc gdpats) }
3139         | gdpat        { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] }
3140
3141 -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
3142 -- generate the open brace in addition to the vertical bar in the lexer, and
3143 -- we don't need it.
3144 ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }
3145          : '{' gdpats '}'                 {% runPV $2 >>= \ $2 ->
3146                                              return $ sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }
3147          |     gdpats close               {% runPV $1 >>= \ $1 ->
3148                                              return $ sL1 $1 ([],unLoc $1) }
3149
3150 gdpat   :: { forall b. ExpCmdI b => PV (LGRHS GhcPs (Located (b GhcPs))) }
3151         : '|' guardquals '->' exp
3152                                    { runExpCmdPV $4 >>= \ $4 ->
3153                                      ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
3154                                          [mj AnnVbar $1,mu AnnRarrow $3] }
3155
3156 -- 'pat' recognises a pattern, including one with a bang at the top
3157 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
3158 -- Bangs inside are parsed as infix operator applications, so that
3159 -- we parse them right when bang-patterns are off
3160 pat     :: { LPat GhcPs }
3161 pat     :  exp          {% (checkPattern <=< runExpCmdP) $1 }
3162         | '!' aexp      {% runExpCmdP $2 >>= \ $2 ->
3163                            amms (checkPattern (sLL $1 $> (SectionR noExt
3164                                                      (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
3165                                 [mj AnnBang $1] }
3166
3167 bindpat :: { LPat GhcPs }
3168 bindpat :  exp            {% runExpCmdP $1 >>= \ $1 ->
3169                              -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
3170                              checkPattern_msg (text "Possibly caused by a missing 'do'?") $1 }
3171         | '!' aexp        {% runExpCmdP $2 >>= \ $2 ->
3172                              -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
3173                              amms (checkPattern_msg (text "Possibly caused by a missing 'do'?")
3174                                      (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
3175                                   [mj AnnBang $1] }
3176
3177 apat   :: { LPat GhcPs }
3178 apat    : aexp                  {% (checkPattern <=< runExpCmdP) $1 }
3179         | '!' aexp              {% runExpCmdP $2 >>= \ $2 ->
3180                                    amms (checkPattern
3181                                             (sLL $1 $> (SectionR noExt
3182                                                 (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
3183                                         [mj AnnBang $1] }
3184
3185 apats  :: { [LPat GhcPs] }
3186         : apat apats            { $1 : $2 }
3187         | {- empty -}           { [] }
3188
3189 -----------------------------------------------------------------------------
3190 -- Statement sequences
3191
3192 stmtlist :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LStmt GhcPs (Located (b GhcPs))])) }
3193         : '{'           stmts '}'       { $2 >>= \ $2 -> return $
3194                                           sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
3195                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
3196         |     vocurly   stmts close     { $2 >>= \ $2 -> return $
3197                                           cL (gl $2) (fst $ unLoc $2
3198                                                     ,reverse $ snd $ unLoc $2) }
3199
3200 --      do { ;; s ; s ; ; s ;; }
3201 -- The last Stmt should be an expression, but that's hard to enforce
3202 -- here, because we need too much lookahead if we see do { e ; }
3203 -- So we use BodyStmts throughout, and switch the last one over
3204 -- in ParseUtils.checkDo instead
3205
3206 stmts :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LStmt GhcPs (Located (b GhcPs))])) }
3207         : stmts ';' stmt  { $1 >>= \ $1 ->
3208                             $3 >>= \ $3 ->
3209                             if null (snd $ unLoc $1)
3210                               then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
3211                                                      ,$3 : (snd $ unLoc $1)))
3212                               else do
3213                                { ams (head $ snd $ unLoc $1) [mj AnnSemi $2]
3214                                ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(snd $ unLoc $1)) }}
3215
3216         | stmts ';'     {  $1 >>= \ $1 ->
3217                            if null (snd $ unLoc $1)
3218                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1),snd $ unLoc $1))
3219                              else do
3220                                { ams (head $ snd $ unLoc $1)