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