2b70fb7999f2f9b26e67170573a664963c31507b
[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 Prelude
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 RdrName) }
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 AnnModule $2, mj AnnWhere $6] ++ fst $7) }
671
672 module :: { Located (HsModule RdrName) }
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 RdrName], [LHsDecl RdrName])) }
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 RdrName], [LHsDecl RdrName])) }
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 RdrName], [LHsDecl RdrName])) }
719         : semis top1                            { ($1, $2) }
720
721 top1    :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
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 RdrName) }
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 RdrName] }
744         :  '{'            header_top            { $2 }
745         |      vocurly    header_top            { $2 }
746
747 header_body2 :: { [LImportDecl RdrName] }
748         :  '{' header_top                       { $2 }
749         |  missing_module_keyword header_top    { $2 }
750
751 header_top :: { [LImportDecl RdrName] }
752         :  semis header_top_importdecls         { $2 }
753
754 header_top_importdecls :: { [LImportDecl RdrName] }
755         :  importdecls_semi                     { $1 }
756         |  importdecls                          { $1 }
757
758 -----------------------------------------------------------------------------
759 -- The Export List
760
761 maybeexports :: { (Maybe (Located [LIE RdrName])) }
762         :  '(' exportlist ')'       {% ams (sLL $1 $> ()) [mop $1,mcp $3] >>
763                                        return (Just (sLL $1 $> (fromOL $2))) }
764         |  {- empty -}              { Nothing }
765
766 exportlist :: { OrdList (LIE RdrName) }
767         : expdoclist ',' expdoclist   {% addAnnotation (oll $1) AnnComma (gl $2)
768                                          >> return ($1 `appOL` $3) }
769         | exportlist1                 { $1 }
770
771 exportlist1 :: { OrdList (LIE RdrName) }
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 RdrName) }
780         : exp_doc expdoclist                           { $1 `appOL` $2 }
781         | {- empty -}                                  { nilOL }
782
783 exp_doc :: { OrdList (LIE RdrName) }
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 RdrName) }
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 $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 (Maybe RdrName)]) }
807   : {- empty -}                   { ([],[]) }
808   | qcnames1                      { $1 }
809
810 qcnames1 :: { ([AddAnn], [Located (Maybe RdrName)]) }     -- A reversed list
811         :  qcnames1 ',' qcname_ext_w_wildcard  {% case (head (snd $1)) of
812                                                     l@(L _ Nothing) ->
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 (Maybe RdrName)) }
826         :  qcname_ext               { sL1 $1 ([],Just `fmap` $1) }
827         |  '..'                     { sL1 $1 ([mj AnnDotdot $1], sL1 $1 Nothing) }
828
829 qcname_ext :: { Located RdrName }
830         :  qcname                   { $1 }
831         |  'type' oqtycon           {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
832                                             [mj AnnType $1,mj AnnVal $2] }
833
834 qcname  :: { Located RdrName }  -- Variable or type constructor
835         :  qvar                 { $1 } -- Things which look like functions
836                                        -- Note: This includes record selectors but
837                                        -- also (-.->), see #11432
838         |  oqtycon_no_varcon    { $1 } -- see Note [Type constructors in export list]
839
840 -----------------------------------------------------------------------------
841 -- Import Declarations
842
843 -- importdecls and topdecls must contain at least one declaration;
844 -- top handles the fact that these may be optional.
845
846 -- One or more semicolons
847 semis1  :: { [AddAnn] }
848 semis1  : semis1 ';'  { mj AnnSemi $2 : $1 }
849         | ';'         { [mj AnnSemi $1] }
850
851 -- Zero or more semicolons
852 semis   :: { [AddAnn] }
853 semis   : semis ';'   { mj AnnSemi $2 : $1 }
854         | {- empty -} { [] }
855
856 -- No trailing semicolons, non-empty
857 importdecls :: { [LImportDecl RdrName] }
858 importdecls
859         : importdecls_semi importdecl
860                                 { $2 : $1 }
861
862 -- May have trailing semicolons, can be empty
863 importdecls_semi :: { [LImportDecl RdrName] }
864 importdecls_semi
865         : importdecls_semi importdecl semis1
866                                 {% ams $2 $3 >> return ($2 : $1) }
867         | {- empty -}           { [] }
868
869 importdecl :: { LImportDecl RdrName }
870         : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
871                 {% ams (L (comb4 $1 $6 (snd $7) $8) $
872                   ImportDecl { ideclSourceSrc = snd $ fst $2
873                              , ideclName = $6, ideclPkgQual = snd $5
874                              , ideclSource = snd $2, ideclSafe = snd $3
875                              , ideclQualified = snd $4, ideclImplicit = False
876                              , ideclAs = unLoc (snd $7)
877                              , ideclHiding = unLoc $8 })
878                    ((mj AnnImport $1 : (fst $ fst $2) ++ fst $3 ++ fst $4
879                                     ++ fst $5 ++ fst $7)) }
880
881 maybe_src :: { (([AddAnn],SourceText),IsBootInterface) }
882         : '{-# SOURCE' '#-}'        { (([mo $1,mc $2],getSOURCE_PRAGs $1)
883                                       ,True) }
884         | {- empty -}               { (([],NoSourceText),False) }
885
886 maybe_safe :: { ([AddAnn],Bool) }
887         : 'safe'                                { ([mj AnnSafe $1],True) }
888         | {- empty -}                           { ([],False) }
889
890 maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
891         : STRING  {% let pkgFS = getSTRING $1 in
892                      if looksLikePackageName (unpackFS pkgFS)
893                         then return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS))
894                         else parseErrorSDoc (getLoc $1) $ vcat [
895                              text "parse error" <> colon <+> quotes (ppr pkgFS),
896                              text "Version number or non-alphanumeric" <+>
897                              text "character in package name"] }
898         | {- empty -}                           { ([],Nothing) }
899
900 optqualified :: { ([AddAnn],Bool) }
901         : 'qualified'                           { ([mj AnnQualified $1],True)  }
902         | {- empty -}                           { ([],False) }
903
904 maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) }
905         : 'as' modid                           { ([mj AnnAs $1]
906                                                  ,sLL $1 $> (Just $2)) }
907         | {- empty -}                          { ([],noLoc Nothing) }
908
909 maybeimpspec :: { Located (Maybe (Bool, Located [LIE RdrName])) }
910         : impspec                  {% let (b, ie) = unLoc $1 in
911                                        checkImportSpec ie
912                                         >>= \checkedIe ->
913                                           return (L (gl $1) (Just (b, checkedIe)))  }
914         | {- empty -}              { noLoc Nothing }
915
916 impspec :: { Located (Bool, Located [LIE RdrName]) }
917         :  '(' exportlist ')'               {% ams (sLL $1 $> (False,
918                                                       sLL $1 $> $ fromOL $2))
919                                                    [mop $1,mcp $3] }
920         |  'hiding' '(' exportlist ')'      {% ams (sLL $1 $> (True,
921                                                       sLL $1 $> $ fromOL $3))
922                                                [mj AnnHiding $1,mop $2,mcp $4] }
923
924 -----------------------------------------------------------------------------
925 -- Fixity Declarations
926
927 prec    :: { Located (SourceText,Int) }
928         : {- empty -}           { noLoc (NoSourceText,9) }
929         | INTEGER
930                  {% checkPrecP (sL1 $1 (getINTEGERs $1,fromInteger (getINTEGER $1))) }
931
932 infix   :: { Located FixityDirection }
933         : 'infix'                               { sL1 $1 InfixN  }
934         | 'infixl'                              { sL1 $1 InfixL  }
935         | 'infixr'                              { sL1 $1 InfixR }
936
937 ops     :: { Located (OrdList (Located RdrName)) }
938         : ops ',' op       {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
939                               return (sLL $1 $> ((unLoc $1) `appOL` unitOL $3))}
940         | op               { sL1 $1 (unitOL $1) }
941
942 -----------------------------------------------------------------------------
943 -- Top-Level Declarations
944
945 -- No trailing semicolons, non-empty
946 topdecls :: { OrdList (LHsDecl RdrName) }
947         : topdecls_semi topdecl        { $1 `snocOL` $2 }
948
949 -- May have trailing semicolons, can be empty
950 topdecls_semi :: { OrdList (LHsDecl RdrName) }
951         : topdecls_semi topdecl semis1 {% ams $2 $3 >> return ($1 `snocOL` $2) }
952         | {- empty -}                  { nilOL }
953
954 topdecl :: { LHsDecl RdrName }
955         : cl_decl                               { sL1 $1 (TyClD (unLoc $1)) }
956         | ty_decl                               { sL1 $1 (TyClD (unLoc $1)) }
957         | inst_decl                             { sL1 $1 (InstD (unLoc $1)) }
958         | stand_alone_deriving                  { sLL $1 $> (DerivD (unLoc $1)) }
959         | role_annot                            { sL1 $1 (RoleAnnotD (unLoc $1)) }
960         | 'default' '(' comma_types0 ')'    {% ams (sLL $1 $> (DefD (DefaultDecl $3)))
961                                                          [mj AnnDefault $1
962                                                          ,mop $2,mcp $4] }
963         | 'foreign' fdecl          {% ams (sLL $1 $> (snd $ unLoc $2))
964                                            (mj AnnForeign $1:(fst $ unLoc $2)) }
965         | '{-# DEPRECATED' deprecations '#-}'   {% ams (sLL $1 $> $ WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2)))
966                                                        [mo $1,mc $3] }
967         | '{-# WARNING' warnings '#-}'          {% ams (sLL $1 $> $ WarningD (Warnings (getWARNING_PRAGs $1) (fromOL $2)))
968                                                        [mo $1,mc $3] }
969         | '{-# RULES' rules '#-}'               {% ams (sLL $1 $> $ RuleD (HsRules (getRULES_PRAGs $1) (fromOL $2)))
970                                                        [mo $1,mc $3] }
971         | '{-# VECTORISE' qvar '=' exp '#-}' {% ams (sLL $1 $> $ VectD (HsVect (getVECT_PRAGs $1) $2 $4))
972                                                     [mo $1,mj AnnEqual $3
973                                                     ,mc $5] }
974         | '{-# NOVECTORISE' qvar '#-}'       {% ams (sLL $1 $> $ VectD (HsNoVect (getNOVECT_PRAGs $1) $2))
975                                                      [mo $1,mc $3] }
976         | '{-# VECTORISE' 'type' gtycon '#-}'
977                                 {% ams (sLL $1 $> $
978                                     VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 Nothing))
979                                     [mo $1,mj AnnType $2,mc $4] }
980
981         | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
982                                 {% ams (sLL $1 $> $
983                                     VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 Nothing))
984                                     [mo $1,mj AnnType $2,mc $4] }
985
986         | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
987                                 {% ams (sLL $1 $> $
988                                     VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 (Just $5)))
989                                     [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
990         | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
991                                 {% ams (sLL $1 $> $
992                                     VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 (Just $5)))
993                                     [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
994
995         | '{-# VECTORISE' 'class' gtycon '#-}'
996                                          {% ams (sLL $1 $>  $ VectD (HsVectClassIn (getVECT_PRAGs $1) $3))
997                                                  [mo $1,mj AnnClass $2,mc $4] }
998         | annotation { $1 }
999         | decl_no_th                            { $1 }
1000
1001         -- Template Haskell Extension
1002         -- The $(..) form is one possible form of infixexp
1003         -- but we treat an arbitrary expression just as if
1004         -- it had a $(..) wrapped around it
1005         | infixexp_top                          { sLL $1 $> $ mkSpliceDecl $1 }
1006
1007 -- Type classes
1008 --
1009 cl_decl :: { LTyClDecl RdrName }
1010         : 'class' tycl_hdr fds where_cls
1011                 {% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))
1012                         (mj AnnClass $1:(fst $ unLoc $3)++(fst $ unLoc $4)) }
1013
1014 -- Type declarations (toplevel)
1015 --
1016 ty_decl :: { LTyClDecl RdrName }
1017            -- ordinary type synonyms
1018         : 'type' type '=' ctypedoc
1019                 -- Note ctype, not sigtype, on the right of '='
1020                 -- We allow an explicit for-all but we don't insert one
1021                 -- in   type Foo a = (b,b)
1022                 -- Instead we just say b is out of scope
1023                 --
1024                 -- Note the use of type for the head; this allows
1025                 -- infix type constructors to be declared
1026                 {% amms (mkTySynonym (comb2 $1 $4) $2 $4)
1027                         [mj AnnType $1,mj AnnEqual $3] }
1028
1029            -- type family declarations
1030         | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info
1031                           where_type_family
1032                 -- Note the use of type for the head; this allows
1033                 -- infix type constructors to be declared
1034                 {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $6) $3
1035                                    (snd $ unLoc $4) (snd $ unLoc $5))
1036                         (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)
1037                            ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) }
1038
1039           -- ordinary data type or newtype declaration
1040         | data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings
1041                 {% amms (mkTyData (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
1042                            Nothing (reverse (snd $ unLoc $4))
1043                                    (fmap reverse $5))
1044                                    -- We need the location on tycl_hdr in case
1045                                    -- constrs and deriving are both empty
1046                         ((fst $ unLoc $1):(fst $ unLoc $4)) }
1047
1048           -- ordinary GADT declaration
1049         | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
1050                  gadt_constrlist
1051                  maybe_derivings
1052             {% amms (mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
1053                             (snd $ unLoc $4) (snd $ unLoc $5)
1054                             (fmap reverse $6) )
1055                                    -- We need the location on tycl_hdr in case
1056                                    -- constrs and deriving are both empty
1057                     ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
1058
1059           -- data/newtype family
1060         | 'data' 'family' type opt_datafam_kind_sig
1061                 {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3
1062                                    (snd $ unLoc $4) Nothing)
1063                         (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
1064
1065 inst_decl :: { LInstDecl RdrName }
1066         : 'instance' overlap_pragma inst_type where_inst
1067        {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
1068              ; let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
1069                                      , cid_sigs = mkClassOpSigs sigs
1070                                      , cid_tyfam_insts = ats
1071                                      , cid_overlap_mode = $2
1072                                      , cid_datafam_insts = adts }
1073              ; ams (L (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_inst = cid }))
1074                    (mj AnnInstance $1 : (fst $ unLoc $4)) } }
1075
1076            -- type instance declarations
1077         | 'type' 'instance' ty_fam_inst_eqn
1078                 {% ams $3 (fst $ unLoc $3)
1079                 >> amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
1080                     (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
1081
1082           -- data/newtype instance declaration
1083         | data_or_newtype 'instance' capi_ctype tycl_hdr constrs
1084                           maybe_derivings
1085             {% amms (mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 $4
1086                                       Nothing (reverse (snd  $ unLoc $5))
1087                                               (fmap reverse $6))
1088                     ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) }
1089
1090           -- GADT instance declaration
1091         | data_or_newtype 'instance' capi_ctype tycl_hdr opt_kind_sig
1092                  gadt_constrlist
1093                  maybe_derivings
1094             {% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 $4
1095                                    (snd $ unLoc $5) (snd $ unLoc $6)
1096                                    (fmap reverse $7))
1097                     ((fst $ unLoc $1):mj AnnInstance $2
1098                        :(fst $ unLoc $5)++(fst $ unLoc $6)) }
1099
1100 overlap_pragma :: { Maybe (Located OverlapMode) }
1101   : '{-# OVERLAPPABLE'    '#-}' {% ajs (Just (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))))
1102                                        [mo $1,mc $2] }
1103   | '{-# OVERLAPPING'     '#-}' {% ajs (Just (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1))))
1104                                        [mo $1,mc $2] }
1105   | '{-# OVERLAPS'        '#-}' {% ajs (Just (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1))))
1106                                        [mo $1,mc $2] }
1107   | '{-# INCOHERENT'      '#-}' {% ajs (Just (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1))))
1108                                        [mo $1,mc $2] }
1109   | {- empty -}                 { Nothing }
1110
1111 deriv_strategy :: { Maybe (Located DerivStrategy) }
1112   : 'stock'                     {% ajs (Just (sL1 $1 StockStrategy))
1113                                        [mj AnnStock $1] }
1114   | 'anyclass'                  {% ajs (Just (sL1 $1 AnyclassStrategy))
1115                                        [mj AnnAnyclass $1] }
1116   | 'newtype'                   {% ajs (Just (sL1 $1 NewtypeStrategy))
1117                                        [mj AnnNewtype $1] }
1118   | {- empty -}                 { Nothing }
1119
1120 -- Injective type families
1121
1122 opt_injective_info :: { Located ([AddAnn], Maybe (LInjectivityAnn RdrName)) }
1123         : {- empty -}               { noLoc ([], Nothing) }
1124         | '|' injectivity_cond      { sLL $1 $> ([mj AnnVbar $1]
1125                                                 , Just ($2)) }
1126
1127 injectivity_cond :: { LInjectivityAnn RdrName }
1128         : tyvarid '->' inj_varids
1129            {% ams (sLL $1 $> (InjectivityAnn $1 (reverse (unLoc $3))))
1130                   [mu AnnRarrow $2] }
1131
1132 inj_varids :: { Located [Located RdrName] }
1133         : inj_varids tyvarid  { sLL $1 $> ($2 : unLoc $1) }
1134         | tyvarid             { sLL $1 $> [$1]            }
1135
1136 -- Closed type families
1137
1138 where_type_family :: { Located ([AddAnn],FamilyInfo RdrName) }
1139         : {- empty -}                      { noLoc ([],OpenTypeFamily) }
1140         | 'where' ty_fam_inst_eqn_list
1141                { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1142                     ,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }
1143
1144 ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn RdrName]) }
1145         :     '{' ty_fam_inst_eqns '}'     { sLL $1 $> ([moc $1,mcc $3]
1146                                                 ,Just (unLoc $2)) }
1147         | vocurly ty_fam_inst_eqns close   { let L loc _ = $2 in
1148                                              L loc ([],Just (unLoc $2)) }
1149         |     '{' '..' '}'                 { sLL $1 $> ([moc $1,mj AnnDotdot $2
1150                                                  ,mcc $3],Nothing) }
1151         | vocurly '..' close               { let L loc _ = $2 in
1152                                              L loc ([mj AnnDotdot $2],Nothing) }
1153
1154 ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
1155         : ty_fam_inst_eqns ';' ty_fam_inst_eqn
1156                                       {% asl (unLoc $1) $2 (snd $ unLoc $3)
1157                                          >> ams $3 (fst $ unLoc $3)
1158                                          >> return (sLL $1 $> ((snd $ unLoc $3) : unLoc $1)) }
1159         | ty_fam_inst_eqns ';'        {% addAnnotation (gl $1) AnnSemi (gl $2)
1160                                          >> return (sLL $1 $>  (unLoc $1)) }
1161         | ty_fam_inst_eqn             {% ams $1 (fst $ unLoc $1)
1162                                          >> return (sLL $1 $> [snd $ unLoc $1]) }
1163         | {- empty -}                 { noLoc [] }
1164
1165 ty_fam_inst_eqn :: { Located ([AddAnn],LTyFamInstEqn RdrName) }
1166         : type '=' ctype
1167                 -- Note the use of type for the head; this allows
1168                 -- infix type constructors and type patterns
1169               {% do { (eqn,ann) <- mkTyFamInstEqn $1 $3
1170                     ; return (sLL $1 $> (mj AnnEqual $2:ann, sLL $1 $> eqn))  } }
1171
1172 -- Associated type family declarations
1173 --
1174 -- * They have a different syntax than on the toplevel (no family special
1175 --   identifier).
1176 --
1177 -- * They also need to be separate from instances; otherwise, data family
1178 --   declarations without a kind signature cause parsing conflicts with empty
1179 --   data declarations.
1180 --
1181 at_decl_cls :: { LHsDecl RdrName }
1182         :  -- data family declarations, with optional 'family' keyword
1183           'data' opt_family type opt_datafam_kind_sig
1184                 {% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
1185                                                   (snd $ unLoc $4) Nothing))
1186                         (mj AnnData $1:$2++(fst $ unLoc $4)) }
1187
1188            -- type family declarations, with optional 'family' keyword
1189            -- (can't use opt_instance because you get shift/reduce errors
1190         | 'type' type opt_at_kind_inj_sig
1191                {% amms (liftM mkTyClD
1192                         (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily $2
1193                                    (fst . snd $ unLoc $3)
1194                                    (snd . snd $ unLoc $3)))
1195                        (mj AnnType $1:(fst $ unLoc $3)) }
1196         | 'type' 'family' type opt_at_kind_inj_sig
1197                {% amms (liftM mkTyClD
1198                         (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily $3
1199                                    (fst . snd $ unLoc $4)
1200                                    (snd . snd $ unLoc $4)))
1201                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)) }
1202
1203            -- default type instances, with optional 'instance' keyword
1204         | 'type' ty_fam_inst_eqn
1205                 {% ams $2 (fst $ unLoc $2) >>
1206                    amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2)))
1207                         (mj AnnType $1:(fst $ unLoc $2)) }
1208         | 'type' 'instance' ty_fam_inst_eqn
1209                 {% ams $3 (fst $ unLoc $3) >>
1210                    amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3)))
1211                         (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }
1212
1213 opt_family   :: { [AddAnn] }
1214               : {- empty -}   { [] }
1215               | 'family'      { [mj AnnFamily $1] }
1216
1217 -- Associated type instances
1218 --
1219 at_decl_inst :: { LInstDecl RdrName }
1220            -- type instance declarations
1221         : 'type' ty_fam_inst_eqn
1222                 -- Note the use of type for the head; this allows
1223                 -- infix type constructors and type patterns
1224                 {% ams $2 (fst $ unLoc $2) >>
1225                    amms (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2))
1226                         (mj AnnType $1:(fst $ unLoc $2)) }
1227
1228         -- data/newtype instance declaration
1229         | data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings
1230                {% amms (mkDataFamInst (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
1231                                     Nothing (reverse (snd $ unLoc $4))
1232                                             (fmap reverse $5))
1233                        ((fst $ unLoc $1):(fst $ unLoc $4)) }
1234
1235         -- GADT instance declaration
1236         | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
1237                  gadt_constrlist
1238                  maybe_derivings
1239                 {% amms (mkDataFamInst (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2
1240                                 $3 (snd $ unLoc $4) (snd $ unLoc $5)
1241                                 (fmap reverse $6))
1242                         ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
1243
1244 data_or_newtype :: { Located (AddAnn, NewOrData) }
1245         : 'data'        { sL1 $1 (mj AnnData    $1,DataType) }
1246         | 'newtype'     { sL1 $1 (mj AnnNewtype $1,NewType) }
1247
1248 -- Family result/return kind signatures
1249
1250 opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind RdrName)) }
1251         :               { noLoc     ([]               , Nothing) }
1252         | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], Just $2) }
1253
1254 opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig RdrName) }
1255         :               { noLoc     ([]               , noLoc NoSig           )}
1256         | '::' kind     { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig $2))}
1257
1258 opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig RdrName) }
1259         :              { noLoc     ([]               , noLoc      NoSig       )}
1260         | '::' kind    { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig  $2))}
1261         | '='  tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig $2))}
1262
1263 opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig RdrName
1264                                             , Maybe (LInjectivityAnn RdrName)))}
1265         :            { noLoc ([], (noLoc NoSig, Nothing)) }
1266         | '::' kind  { sLL $1 $> ( [mu AnnDcolon $1]
1267                                  , (sLL $2 $> (KindSig $2), Nothing)) }
1268         | '='  tv_bndr '|' injectivity_cond
1269                 { sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3]
1270                             , (sLL $1 $2 (TyVarSig $2), Just $4))}
1271
1272 -- tycl_hdr parses the header of a class or data type decl,
1273 -- which takes the form
1274 --      T a b
1275 --      Eq a => T a
1276 --      (Eq a, Ord b) => T a b
1277 --      T Int [a]                       -- for associated types
1278 -- Rather a lot of inlining here, else we get reduce/reduce errors
1279 tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
1280         : context '=>' type         {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
1281                                        >> (return (sLL $1 $> (Just $1, $3)))
1282                                     }
1283         | type                      { sL1 $1 (Nothing, $1) }
1284
1285 capi_ctype :: { Maybe (Located CType) }
1286 capi_ctype : '{-# CTYPE' STRING STRING '#-}'
1287                        {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))
1288                                         (getSTRINGs $3,getSTRING $3))))
1289                               [mo $1,mj AnnHeader $2,mj AnnVal $3,mc $4] }
1290
1291            | '{-# CTYPE'        STRING '#-}'
1292                        {% ajs (Just (sLL $1 $> (CType (getCTYPEs $1) Nothing  (getSTRINGs $2, getSTRING $2))))
1293                               [mo $1,mj AnnVal $2,mc $3] }
1294
1295            |           { Nothing }
1296
1297 -----------------------------------------------------------------------------
1298 -- Stand-alone deriving
1299
1300 -- Glasgow extension: stand-alone deriving declarations
1301 stand_alone_deriving :: { LDerivDecl RdrName }
1302   : 'deriving' deriv_strategy 'instance' overlap_pragma inst_type
1303                 {% do { let { err = text "in the stand-alone deriving instance"
1304                                     <> colon <+> quotes (ppr $5) }
1305                       ; ams (sLL $1 (hsSigType $>) (DerivDecl $5 $2 $4))
1306                             [mj AnnDeriving $1, mj AnnInstance $3] } }
1307
1308 -----------------------------------------------------------------------------
1309 -- Role annotations
1310
1311 role_annot :: { LRoleAnnotDecl RdrName }
1312 role_annot : 'type' 'role' oqtycon maybe_roles
1313           {% amms (mkRoleAnnotDecl (comb3 $1 $3 $4) $3 (reverse (unLoc $4)))
1314                   [mj AnnType $1,mj AnnRole $2] }
1315
1316 -- Reversed!
1317 maybe_roles :: { Located [Located (Maybe FastString)] }
1318 maybe_roles : {- empty -}    { noLoc [] }
1319             | roles          { $1 }
1320
1321 roles :: { Located [Located (Maybe FastString)] }
1322 roles : role             { sLL $1 $> [$1] }
1323       | roles role       { sLL $1 $> $ $2 : unLoc $1 }
1324
1325 -- read it in as a varid for better error messages
1326 role :: { Located (Maybe FastString) }
1327 role : VARID             { sL1 $1 $ Just $ getVARID $1 }
1328      | '_'               { sL1 $1 Nothing }
1329
1330 -- Pattern synonyms
1331
1332 -- Glasgow extension: pattern synonyms
1333 pattern_synonym_decl :: { LHsDecl RdrName }
1334         : 'pattern' pattern_synonym_lhs '=' pat
1335          {%      let (name, args,as ) = $2 in
1336                  ams (sLL $1 $> . ValD $ mkPatSynBind name args $4
1337                                                     ImplicitBidirectional)
1338                (as ++ [mj AnnPattern $1, mj AnnEqual $3])
1339          }
1340
1341         | 'pattern' pattern_synonym_lhs '<-' pat
1342          {%    let (name, args, as) = $2 in
1343                ams (sLL $1 $> . ValD $ mkPatSynBind name args $4 Unidirectional)
1344                (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) }
1345
1346         | 'pattern' pattern_synonym_lhs '<-' pat where_decls
1347             {% do { let (name, args, as) = $2
1348                   ; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
1349                   ; ams (sLL $1 $> . ValD $
1350                            mkPatSynBind name args $4 (ExplicitBidirectional mg))
1351                        (as ++ ((mj AnnPattern $1:mu AnnLarrow $3:(fst $ unLoc $5))) )
1352                    }}
1353
1354 pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName), [AddAnn]) }
1355         : con vars0 { ($1, PrefixPatSyn $2, []) }
1356         | varid conop varid { ($2, InfixPatSyn $1 $3, []) }
1357         | con '{' cvars1 '}' { ($1, RecordPatSyn $3, [moc $2, mcc $4] ) }
1358
1359 vars0 :: { [Located RdrName] }
1360         : {- empty -}                 { [] }
1361         | varid vars0                 { $1 : $2 }
1362
1363 cvars1 :: { [RecordPatSynField (Located RdrName)] }
1364        : varid                        { [RecordPatSynField $1 $1] }
1365        | varid ',' cvars1             {% addAnnotation (getLoc $1) AnnComma (getLoc $2) >>
1366                                          return ((RecordPatSynField $1 $1) : $3 )}
1367
1368 where_decls :: { Located ([AddAnn]
1369                          , Located (OrdList (LHsDecl RdrName))) }
1370         : 'where' '{' decls '}'       { sLL $1 $> ((mj AnnWhere $1:moc $2
1371                                            :mcc $4:(fst $ unLoc $3)),sL1 $3 (snd $ unLoc $3)) }
1372         | 'where' vocurly decls close { L (comb2 $1 $3) ((mj AnnWhere $1:(fst $ unLoc $3))
1373                                           ,sL1 $3 (snd $ unLoc $3)) }
1374
1375 pattern_synonym_sig :: { LSig RdrName }
1376         : 'pattern' con_list '::' sigtype
1377                    {% ams (sLL $1 $> $ PatSynSig (unLoc $2) (mkLHsSigType $4))
1378                           [mj AnnPattern $1, mu AnnDcolon $3] }
1379
1380 -----------------------------------------------------------------------------
1381 -- Nested declarations
1382
1383 -- Declaration in class bodies
1384 --
1385 decl_cls  :: { LHsDecl RdrName }
1386 decl_cls  : at_decl_cls                 { $1 }
1387           | decl                        { $1 }
1388
1389           -- A 'default' signature used with the generic-programming extension
1390           | 'default' infixexp '::' sigtypedoc
1391                     {% do { v <- checkValSigLhs $2
1392                           ; let err = text "in default signature" <> colon <+>
1393                                       quotes (ppr $2)
1394                           ; ams (sLL $1 $> $ SigD $ ClassOpSig True [v] $ mkLHsSigType $4)
1395                                 [mj AnnDefault $1,mu AnnDcolon $3] } }
1396
1397 decls_cls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }  -- Reversed
1398           : decls_cls ';' decl_cls      {% if isNilOL (snd $ unLoc $1)
1399                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1400                                                                     , unitOL $3))
1401                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
1402                                            >> return (sLL $1 $> (fst $ unLoc $1
1403                                                                 ,(snd $ unLoc $1) `appOL` unitOL $3)) }
1404           | decls_cls ';'               {% if isNilOL (snd $ unLoc $1)
1405                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1406                                                                                    ,snd $ unLoc $1))
1407                                              else ams (lastOL (snd $ unLoc $1)) [mj AnnSemi $2]
1408                                            >> return (sLL $1 $>  (unLoc $1)) }
1409           | decl_cls                    { sL1 $1 ([], unitOL $1) }
1410           | {- empty -}                 { noLoc ([],nilOL) }
1411
1412 decllist_cls
1413         :: { Located ([AddAnn]
1414                      , OrdList (LHsDecl RdrName)) }      -- Reversed
1415         : '{'         decls_cls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
1416                                              ,snd $ unLoc $2) }
1417         |     vocurly decls_cls close   { $2 }
1418
1419 -- Class body
1420 --
1421 where_cls :: { Located ([AddAnn]
1422                        ,(OrdList (LHsDecl RdrName))) }    -- Reversed
1423                                 -- No implicit parameters
1424                                 -- May have type declarations
1425         : 'where' decllist_cls          { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1426                                              ,snd $ unLoc $2) }
1427         | {- empty -}                   { noLoc ([],nilOL) }
1428
1429 -- Declarations in instance bodies
1430 --
1431 decl_inst  :: { Located (OrdList (LHsDecl RdrName)) }
1432 decl_inst  : at_decl_inst               { sLL $1 $> (unitOL (sL1 $1 (InstD (unLoc $1)))) }
1433            | decl                       { sLL $1 $> (unitOL $1) }
1434
1435 decls_inst :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }   -- Reversed
1436            : decls_inst ';' decl_inst   {% if isNilOL (snd $ unLoc $1)
1437                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1438                                                                     , unLoc $3))
1439                                              else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1440                                            >> return
1441                                             (sLL $1 $> (fst $ unLoc $1
1442                                                        ,(snd $ unLoc $1) `appOL` unLoc $3)) }
1443            | decls_inst ';'             {% if isNilOL (snd $ unLoc $1)
1444                                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1445                                                                                    ,snd $ unLoc $1))
1446                                              else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1447                                            >> return (sLL $1 $> (unLoc $1)) }
1448            | decl_inst                  { sL1 $1 ([],unLoc $1) }
1449            | {- empty -}                { noLoc ([],nilOL) }
1450
1451 decllist_inst
1452         :: { Located ([AddAnn]
1453                      , OrdList (LHsDecl RdrName)) }      -- Reversed
1454         : '{'         decls_inst '}'    { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) }
1455         |     vocurly decls_inst close  { L (gl $2) (unLoc $2) }
1456
1457 -- Instance body
1458 --
1459 where_inst :: { Located ([AddAnn]
1460                         , OrdList (LHsDecl RdrName)) }   -- Reversed
1461                                 -- No implicit parameters
1462                                 -- May have type declarations
1463         : 'where' decllist_inst         { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
1464                                              ,(snd $ unLoc $2)) }
1465         | {- empty -}                   { noLoc ([],nilOL) }
1466
1467 -- Declarations in binding groups other than classes and instances
1468 --
1469 decls   :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) }
1470         : decls ';' decl    {% if isNilOL (snd $ unLoc $1)
1471                                  then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
1472                                                         , unitOL $3))
1473                                  else do ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1474                                            >> return (
1475                                           let { this = unitOL $3;
1476                                                 rest = snd $ unLoc $1;
1477                                                 these = rest `appOL` this }
1478                                           in rest `seq` this `seq` these `seq`
1479                                              (sLL $1 $> (fst $ unLoc $1,these))) }
1480         | decls ';'          {% if isNilOL (snd $ unLoc $1)
1481                                   then return (sLL $1 $> ((mj AnnSemi $2:(fst $ unLoc $1)
1482                                                           ,snd $ unLoc $1)))
1483                                   else ams (lastOL $ snd $ unLoc $1) [mj AnnSemi $2]
1484                                            >> return (sLL $1 $> (unLoc $1)) }
1485         | decl                          { sL1 $1 ([], unitOL $1) }
1486         | {- empty -}                   { noLoc ([],nilOL) }
1487
1488 decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl RdrName))) }
1489         : '{'            decls '}'     { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
1490                                                    ,sL1 $2 $ snd $ unLoc $2) }
1491         |     vocurly    decls close   { L (gl $2) (fst $ unLoc $2,sL1 $2 $ snd $ unLoc $2) }
1492
1493 -- Binding groups other than those of class and instance declarations
1494 --
1495 binds   ::  { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
1496                                          -- May have implicit parameters
1497                                                 -- No type declarations
1498         : decllist          {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)
1499                                   ; return (sL1 $1 (fst $ unLoc $1
1500                                                     ,sL1 $1 $ HsValBinds val_binds)) } }
1501
1502         | '{'            dbinds '}'     { sLL $1 $> ([moc $1,mcc $3]
1503                                              ,sL1 $2 $ HsIPBinds (IPBinds (reverse $ unLoc $2)
1504                                                          emptyTcEvBinds)) }
1505
1506         |     vocurly    dbinds close   { L (getLoc $2) ([]
1507                                             ,sL1 $2 $ HsIPBinds (IPBinds (reverse $ unLoc $2)
1508                                                         emptyTcEvBinds)) }
1509
1510
1511 wherebinds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) }
1512                                                 -- May have implicit parameters
1513                                                 -- No type declarations
1514         : 'where' binds                 { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2)
1515                                              ,snd $ unLoc $2) }
1516         | {- empty -}                   { noLoc ([],noLoc emptyLocalBinds) }
1517
1518
1519 -----------------------------------------------------------------------------
1520 -- Transformation Rules
1521
1522 rules   :: { OrdList (LRuleDecl RdrName) }
1523         :  rules ';' rule              {% addAnnotation (oll $1) AnnSemi (gl $2)
1524                                           >> return ($1 `snocOL` $3) }
1525         |  rules ';'                   {% addAnnotation (oll $1) AnnSemi (gl $2)
1526                                           >> return $1 }
1527         |  rule                        { unitOL $1 }
1528         |  {- empty -}                 { nilOL }
1529
1530 rule    :: { LRuleDecl RdrName }
1531         : STRING rule_activation rule_forall infixexp '=' exp
1532          {%ams (sLL $1 $> $ (HsRule (L (gl $1) (getSTRINGs $1,getSTRING $1))
1533                                   ((snd $2) `orElse` AlwaysActive)
1534                                   (snd $3) $4 placeHolderNames $6
1535                                   placeHolderNames))
1536                (mj AnnEqual $5 : (fst $2) ++ (fst $3)) }
1537
1538 -- Rules can be specified to be NeverActive, unlike inline/specialize pragmas
1539 rule_activation :: { ([AddAnn],Maybe Activation) }
1540         : {- empty -}                           { ([],Nothing) }
1541         | rule_explicit_activation              { (fst $1,Just (snd $1)) }
1542
1543 rule_explicit_activation :: { ([AddAnn]
1544                               ,Activation) }  -- In brackets
1545         : '[' INTEGER ']'       { ([mos $1,mj AnnVal $2,mcs $3]
1546                                   ,ActiveAfter  (getINTEGERs $2) (fromInteger (getINTEGER $2))) }
1547         | '[' '~' INTEGER ']'   { ([mos $1,mj AnnTilde $2,mj AnnVal $3,mcs $4]
1548                                   ,ActiveBefore (getINTEGERs $3) (fromInteger (getINTEGER $3))) }
1549         | '[' '~' ']'           { ([mos $1,mj AnnTilde $2,mcs $3]
1550                                   ,NeverActive) }
1551
1552 rule_forall :: { ([AddAnn],[LRuleBndr RdrName]) }
1553         : 'forall' rule_var_list '.'     { ([mu AnnForall $1,mj AnnDot $3],$2) }
1554         | {- empty -}                    { ([],[]) }
1555
1556 rule_var_list :: { [LRuleBndr RdrName] }
1557         : rule_var                              { [$1] }
1558         | rule_var rule_var_list                { $1 : $2 }
1559
1560 rule_var :: { LRuleBndr RdrName }
1561         : varid                         { sLL $1 $> (RuleBndr $1) }
1562         | '(' varid '::' ctype ')'      {% ams (sLL $1 $> (RuleBndrSig $2
1563                                                        (mkLHsSigWcType $4)))
1564                                                [mop $1,mu AnnDcolon $3,mcp $5] }
1565
1566 -----------------------------------------------------------------------------
1567 -- Warnings and deprecations (c.f. rules)
1568
1569 warnings :: { OrdList (LWarnDecl RdrName) }
1570         : warnings ';' warning         {% addAnnotation (oll $1) AnnSemi (gl $2)
1571                                           >> return ($1 `appOL` $3) }
1572         | warnings ';'                 {% addAnnotation (oll $1) AnnSemi (gl $2)
1573                                           >> return $1 }
1574         | warning                      { $1 }
1575         | {- empty -}                  { nilOL }
1576
1577 -- SUP: TEMPORARY HACK, not checking for `module Foo'
1578 warning :: { OrdList (LWarnDecl RdrName) }
1579         : namelist strings
1580                 {% amsu (sLL $1 $> (Warning (unLoc $1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
1581                      (fst $ unLoc $2) }
1582
1583 deprecations :: { OrdList (LWarnDecl RdrName) }
1584         : deprecations ';' deprecation
1585                                        {% addAnnotation (oll $1) AnnSemi (gl $2)
1586                                           >> return ($1 `appOL` $3) }
1587         | deprecations ';'             {% addAnnotation (oll $1) AnnSemi (gl $2)
1588                                           >> return $1 }
1589         | deprecation                  { $1 }
1590         | {- empty -}                  { nilOL }
1591
1592 -- SUP: TEMPORARY HACK, not checking for `module Foo'
1593 deprecation :: { OrdList (LWarnDecl RdrName) }
1594         : namelist strings
1595              {% amsu (sLL $1 $> $ (Warning (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
1596                      (fst $ unLoc $2) }
1597
1598 strings :: { Located ([AddAnn],[Located StringLiteral]) }
1599     : STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) }
1600     | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) }
1601
1602 stringlist :: { Located (OrdList (Located StringLiteral)) }
1603     : stringlist ',' STRING {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
1604                                return (sLL $1 $> (unLoc $1 `snocOL`
1605                                                   (L (gl $3) (getStringLiteral $3)))) }
1606     | STRING                { sLL $1 $> (unitOL (L (gl $1) (getStringLiteral $1))) }
1607     | {- empty -}           { noLoc nilOL }
1608
1609 -----------------------------------------------------------------------------
1610 -- Annotations
1611 annotation :: { LHsDecl RdrName }
1612     : '{-# ANN' name_var aexp '#-}'      {% ams (sLL $1 $> (AnnD $ HsAnnotation
1613                                             (getANN_PRAGs $1)
1614                                             (ValueAnnProvenance $2) $3))
1615                                             [mo $1,mc $4] }
1616
1617     | '{-# ANN' 'type' tycon aexp '#-}'  {% ams (sLL $1 $> (AnnD $ HsAnnotation
1618                                             (getANN_PRAGs $1)
1619                                             (TypeAnnProvenance $3) $4))
1620                                             [mo $1,mj AnnType $2,mc $5] }
1621
1622     | '{-# ANN' 'module' aexp '#-}'      {% ams (sLL $1 $> (AnnD $ HsAnnotation
1623                                                 (getANN_PRAGs $1)
1624                                                  ModuleAnnProvenance $3))
1625                                                 [mo $1,mj AnnModule $2,mc $4] }
1626
1627
1628 -----------------------------------------------------------------------------
1629 -- Foreign import and export declarations
1630
1631 fdecl :: { Located ([AddAnn],HsDecl RdrName) }
1632 fdecl : 'import' callconv safety fspec
1633                {% mkImport $2 $3 (snd $ unLoc $4) >>= \i ->
1634                  return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i))  }
1635       | 'import' callconv        fspec
1636                {% do { d <- mkImport $2 (noLoc PlaySafe) (snd $ unLoc $3);
1637                     return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $3),d)) }}
1638       | 'export' callconv fspec
1639                {% mkExport $2 (snd $ unLoc $3) >>= \i ->
1640                   return (sLL $1 $> (mj AnnExport $1 : (fst $ unLoc $3),i) ) }
1641
1642 callconv :: { Located CCallConv }
1643           : 'stdcall'                   { sLL $1 $> StdCallConv }
1644           | 'ccall'                     { sLL $1 $> CCallConv   }
1645           | 'capi'                      { sLL $1 $> CApiConv    }
1646           | 'prim'                      { sLL $1 $> PrimCallConv}
1647           | 'javascript'                { sLL $1 $> JavaScriptCallConv }
1648
1649 safety :: { Located Safety }
1650         : 'unsafe'                      { sLL $1 $> PlayRisky }
1651         | 'safe'                        { sLL $1 $> PlaySafe }
1652         | 'interruptible'               { sLL $1 $> PlayInterruptible }
1653
1654 fspec :: { Located ([AddAnn]
1655                     ,(Located StringLiteral, Located RdrName, LHsSigType RdrName)) }
1656        : STRING var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $3]
1657                                              ,(L (getLoc $1)
1658                                                     (getStringLiteral $1), $2, mkLHsSigType $4)) }
1659        |        var '::' sigtypedoc     { sLL $1 $> ([mu AnnDcolon $2]
1660                                              ,(noLoc (StringLiteral NoSourceText nilFS), $1, mkLHsSigType $3)) }
1661          -- if the entity string is missing, it defaults to the empty string;
1662          -- the meaning of an empty entity string depends on the calling
1663          -- convention
1664
1665 -----------------------------------------------------------------------------
1666 -- Type signatures
1667
1668 opt_sig :: { ([AddAnn], Maybe (LHsType RdrName)) }
1669         : {- empty -}                   { ([],Nothing) }
1670         | '::' sigtype                  { ([mu AnnDcolon $1],Just $2) }
1671
1672 opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) }
1673         : {- empty -}                   { ([],Nothing) }
1674         | '::' atype                    { ([mu AnnDcolon $1],Just $2) }
1675
1676 opt_tyconsig :: { ([AddAnn], Maybe (Located RdrName)) }
1677              : {- empty -}              { ([], Nothing) }
1678              | '::' gtycon              { ([mu AnnDcolon $1], Just $2) }
1679
1680 sigtype :: { LHsType RdrName }
1681         : ctype                            { $1 }
1682
1683 sigtypedoc :: { LHsType RdrName }
1684         : ctypedoc                         { $1 }
1685
1686
1687 sig_vars :: { Located [Located RdrName] }    -- Returned in reversed order
1688          : sig_vars ',' var           {% addAnnotation (gl $ head $ unLoc $1)
1689                                                        AnnComma (gl $2)
1690                                          >> return (sLL $1 $> ($3 : unLoc $1)) }
1691          | var                        { sL1 $1 [$1] }
1692
1693 sigtypes1 :: { (OrdList (LHsSigType RdrName)) }
1694    : sigtype                 { unitOL (mkLHsSigType $1) }
1695    | sigtype ',' sigtypes1   {% addAnnotation (gl $1) AnnComma (gl $2)
1696                                 >> return (unitOL (mkLHsSigType $1) `appOL` $3) }
1697
1698 -----------------------------------------------------------------------------
1699 -- Types
1700
1701 strict_mark :: { Located ([AddAnn],HsSrcBang) }
1702         : strictness { sL1 $1 (let (a, str) = unLoc $1 in (a, HsSrcBang NoSourceText NoSrcUnpack str)) }
1703         | unpackedness { sL1 $1 (let (a, prag, unpk) = unLoc $1 in (a, HsSrcBang prag unpk NoSrcStrict)) }
1704         | unpackedness strictness { sLL $1 $> (let { (a, prag, unpk) = unLoc $1
1705                                                    ; (a', str) = unLoc $2 }
1706                                                 in (a ++ a', HsSrcBang prag unpk str)) }
1707         -- Although UNPACK with no '!' without StrictData and UNPACK with '~' are illegal,
1708         -- we get a better error message if we parse them here
1709
1710 strictness :: { Located ([AddAnn], SrcStrictness) }
1711         : '!' { sL1 $1 ([mj AnnBang $1], SrcStrict) }
1712         | '~' { sL1 $1 ([mj AnnTilde $1], SrcLazy) }
1713
1714 unpackedness :: { Located ([AddAnn], SourceText, SrcUnpackedness) }
1715         : '{-# UNPACK' '#-}'   { sLL $1 $> ([mo $1, mc $2], getUNPACK_PRAGs $1, SrcUnpack) }
1716         | '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], getNOUNPACK_PRAGs $1, SrcNoUnpack) }
1717
1718 -- A ctype is a for-all type
1719 ctype   :: { LHsType RdrName }
1720         : 'forall' tv_bndrs '.' ctype   {% hintExplicitForall (getLoc $1) >>
1721                                            ams (sLL $1 $> $
1722                                                 HsForAllTy { hst_bndrs = $2
1723                                                            , hst_body = $4 })
1724                                                [mu AnnForall $1, mj AnnDot $3] }
1725         | context '=>' ctype          {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
1726                                          >> return (sLL $1 $> $
1727                                             HsQualTy { hst_ctxt = $1
1728                                                      , hst_body = $3 }) }
1729         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy $1 $3))
1730                                              [mu AnnDcolon $2] }
1731         | type                        { $1 }
1732
1733 ----------------------
1734 -- Notes for 'ctypedoc'
1735 -- It would have been nice to simplify the grammar by unifying `ctype` and
1736 -- ctypedoc` into one production, allowing comments on types everywhere (and
1737 -- rejecting them after parsing, where necessary).  This is however not possible
1738 -- since it leads to ambiguity. The reason is the support for comments on record
1739 -- fields:
1740 --         data R = R { field :: Int -- ^ comment on the field }
1741 -- If we allow comments on types here, it's not clear if the comment applies
1742 -- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
1743
1744 ctypedoc :: { LHsType RdrName }
1745         : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
1746                                             ams (sLL $1 $> $
1747                                                  HsForAllTy { hst_bndrs = $2
1748                                                             , hst_body = $4 })
1749                                                 [mu AnnForall $1,mj AnnDot $3] }
1750         | context '=>' ctypedoc       {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
1751                                          >> return (sLL $1 $> $
1752                                             HsQualTy { hst_ctxt = $1
1753                                                      , hst_body = $3 }) }
1754         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy $1 $3))
1755                                              [mu AnnDcolon $2] }
1756         | typedoc                     { $1 }
1757
1758 ----------------------
1759 -- Notes for 'context'
1760 -- We parse a context as a btype so that we don't get reduce/reduce
1761 -- errors in ctype.  The basic problem is that
1762 --      (Eq a, Ord a)
1763 -- looks so much like a tuple type.  We can't tell until we find the =>
1764
1765 -- We have the t1 ~ t2 form both in 'context' and in type,
1766 -- to permit an individual equational constraint without parenthesis.
1767 -- Thus for some reason we allow    f :: a~b => blah
1768 -- but not                          f :: ?x::Int => blah
1769 -- See Note [Parsing ~]
1770 context :: { LHsContext RdrName }
1771         :  btype                        {% do { (anns,ctx) <- checkContext $1
1772                                                 ; if null (unLoc ctx)
1773                                                    then addAnnotation (gl $1) AnnUnit (gl $1)
1774                                                    else return ()
1775                                                 ; ams ctx anns
1776                                                 } }
1777
1778 context_no_ops :: { LHsContext RdrName }
1779         : btype_no_ops                 {% do { ty <- splitTilde $1
1780                                              ; (anns,ctx) <- checkContext ty
1781                                              ; if null (unLoc ctx)
1782                                                    then addAnnotation (gl ty) AnnUnit (gl ty)
1783                                                    else return ()
1784                                              ; ams ctx anns
1785                                              } }
1786
1787 {- Note [GADT decl discards annotations]
1788 ~~~~~~~~~~~~~~~~~~~~~
1789 The type production for
1790
1791     btype `->` btype
1792
1793 adds the AnnRarrow annotation twice, in different places.
1794
1795 This is because if the type is processed as usual, it belongs on the annotations
1796 for the type as a whole.
1797
1798 But if the type is passed to mkGadtDecl, it discards the top level SrcSpan, and
1799 the top-level annotation will be disconnected. Hence for this specific case it
1800 is connected to the first type too.
1801 -}
1802
1803 type :: { LHsType RdrName }
1804         : btype                        { $1 }
1805         | btype '->' ctype             {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
1806                                        >> ams (sLL $1 $> $ HsFunTy $1 $3)
1807                                               [mu AnnRarrow $2] }
1808
1809
1810 typedoc :: { LHsType RdrName }
1811         : btype                          { $1 }
1812         | btype docprev                  { sLL $1 $> $ HsDocTy $1 $2 }
1813         | btype '->'     ctypedoc        {% ams (sLL $1 $> $ HsFunTy $1 $3)
1814                                                 [mu AnnRarrow $2] }
1815         | btype docprev '->' ctypedoc    {% ams (sLL $1 $> $
1816                                                  HsFunTy (L (comb2 $1 $2) (HsDocTy $1 $2))
1817                                                          $4)
1818                                                 [mu AnnRarrow $3] }
1819
1820 -- See Note [Parsing ~]
1821 btype :: { LHsType RdrName }
1822         : tyapps                      {%  splitTildeApps (reverse (unLoc $1)) >>=
1823                                           \ts -> return $ sL1 $1 $ HsAppsTy ts }
1824
1825 -- Used for parsing Haskell98-style data constructors,
1826 -- in order to forbid the blasphemous
1827 -- > data Foo = Int :+ Char :* Bool
1828 -- See also Note [Parsing data constructors is hard] in RdrHsSyn
1829 btype_no_ops :: { LHsType RdrName }
1830         : btype_no_ops atype            { sLL $1 $> $ HsAppTy $1 $2 }
1831         | atype                         { $1 }
1832
1833 tyapps :: { Located [LHsAppType RdrName] }   -- NB: This list is reversed
1834         : tyapp                         { sL1 $1 [$1] }
1835         | tyapps tyapp                  { sLL $1 $> $ $2 : (unLoc $1) }
1836
1837 -- See Note [HsAppsTy] in HsTypes
1838 tyapp :: { LHsAppType RdrName }
1839         : atype                         { sL1 $1 $ HsAppPrefix $1 }
1840         | qtyconop                      { sL1 $1 $ HsAppInfix $1 }
1841         | tyvarop                       { sL1 $1 $ HsAppInfix $1 }
1842         | SIMPLEQUOTE qconop            {% ams (sLL $1 $> $ HsAppInfix $2)
1843                                                [mj AnnSimpleQuote $1] }
1844         | SIMPLEQUOTE varop             {% ams (sLL $1 $> $ HsAppInfix $2)
1845                                                [mj AnnSimpleQuote $1] }
1846
1847 atype :: { LHsType RdrName }
1848         : ntgtycon                       { sL1 $1 (HsTyVar NotPromoted $1) }      -- Not including unit tuples
1849         | tyvar                          { sL1 $1 (HsTyVar NotPromoted $1) }      -- (See Note [Unit tuples])
1850         | strict_mark atype              {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2))
1851                                                 (fst $ unLoc $1) }  -- Constructor sigs only
1852         | '{' fielddecls '}'             {% amms (checkRecordSyntax
1853                                                     (sLL $1 $> $ HsRecTy $2))
1854                                                         -- Constructor sigs only
1855                                                  [moc $1,mcc $3] }
1856         | '(' ')'                        {% ams (sLL $1 $> $ HsTupleTy
1857                                                     HsBoxedOrConstraintTuple [])
1858                                                 [mop $1,mcp $2] }
1859         | '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
1860                                                           (gl $3) >>
1861                                             ams (sLL $1 $> $ HsTupleTy
1862                                              HsBoxedOrConstraintTuple ($2 : $4))
1863                                                 [mop $1,mcp $5] }
1864         | '(#' '#)'                   {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple [])
1865                                              [mo $1,mc $2] }
1866         | '(#' comma_types1 '#)'      {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple $2)
1867                                              [mo $1,mc $3] }
1868         | '(#' bar_types2 '#)'        {% ams (sLL $1 $> $ HsSumTy $2)
1869                                              [mo $1,mc $3] }
1870         | '[' ctype ']'               {% ams (sLL $1 $> $ HsListTy  $2) [mos $1,mcs $3] }
1871         | '[:' ctype ':]'             {% ams (sLL $1 $> $ HsPArrTy  $2) [mo $1,mc $3] }
1872         | '(' ctype ')'               {% ams (sLL $1 $> $ HsParTy   $2) [mop $1,mcp $3] }
1873         | '(' ctype '::' kind ')'     {% ams (sLL $1 $> $ HsKindSig $2 $4)
1874                                              [mop $1,mu AnnDcolon $3,mcp $5] }
1875         | quasiquote                  { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
1876         | '$(' exp ')'                {% ams (sLL $1 $> $ mkHsSpliceTy HasParens $2)
1877                                              [mj AnnOpenPE $1,mj AnnCloseP $3] }
1878         | TH_ID_SPLICE                {%ams (sLL $1 $> $ mkHsSpliceTy NoParens $ sL1 $1 $ HsVar $
1879                                              (sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1))))
1880                                              [mj AnnThIdSplice $1] }
1881                                       -- see Note [Promotion] for the followings
1882         | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar Promoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
1883         | SIMPLEQUOTE  '(' ctype ',' comma_types1 ')'
1884                              {% addAnnotation (gl $3) AnnComma (gl $4) >>
1885                                 ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5))
1886                                     [mj AnnSimpleQuote $1,mop $2,mcp $6] }
1887         | SIMPLEQUOTE  '[' comma_types0 ']'     {% ams (sLL $1 $> $ HsExplicitListTy Promoted
1888                                                             placeHolderKind $3)
1889                                                        [mj AnnSimpleQuote $1,mos $2,mcs $4] }
1890         | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar Promoted $2)
1891                                                        [mj AnnSimpleQuote $1,mj AnnName $2] }
1892
1893         -- Two or more [ty, ty, ty] must be a promoted list type, just as
1894         -- if you had written '[ty, ty, ty]
1895         -- (One means a list type, zero means the list type constructor,
1896         -- so you have to quote those.)
1897         | '[' ctype ',' comma_types1 ']'  {% addAnnotation (gl $2) AnnComma
1898                                                            (gl $3) >>
1899                                              ams (sLL $1 $> $ HsExplicitListTy NotPromoted
1900                                                      placeHolderKind ($2 : $4))
1901                                                  [mos $1,mcs $5] }
1902         | INTEGER              { sLL $1 $> $ HsTyLit $ HsNumTy (getINTEGERs $1)
1903                                                                (getINTEGER $1) }
1904         | STRING               { sLL $1 $> $ HsTyLit $ HsStrTy (getSTRINGs $1)
1905                                                                (getSTRING  $1) }
1906         | '_'                  { sL1 $1 $ mkAnonWildCardTy }
1907
1908 -- An inst_type is what occurs in the head of an instance decl
1909 --      e.g.  (Foo a, Gaz b) => Wibble a b
1910 -- It's kept as a single type for convenience.
1911 inst_type :: { LHsSigType RdrName }
1912         : sigtype                       { mkLHsSigType $1 }
1913
1914 deriv_types :: { [LHsSigType RdrName] }
1915         : typedoc                       { [mkLHsSigType $1] }
1916
1917         | typedoc ',' deriv_types       {% addAnnotation (gl $1) AnnComma (gl $2)
1918                                            >> return (mkLHsSigType $1 : $3) }
1919
1920 comma_types0  :: { [LHsType RdrName] }  -- Zero or more:  ty,ty,ty
1921         : comma_types1                  { $1 }
1922         | {- empty -}                   { [] }
1923
1924 comma_types1    :: { [LHsType RdrName] }  -- One or more:  ty,ty,ty
1925         : ctype                        { [$1] }
1926         | ctype  ',' comma_types1      {% addAnnotation (gl $1) AnnComma (gl $2)
1927                                           >> return ($1 : $3) }
1928
1929 bar_types2    :: { [LHsType RdrName] }  -- Two or more:  ty|ty|ty
1930         : ctype  '|' ctype             {% addAnnotation (gl $1) AnnVbar (gl $2)
1931                                           >> return [$1,$3] }
1932         | ctype  '|' bar_types2        {% addAnnotation (gl $1) AnnVbar (gl $2)
1933                                           >> return ($1 : $3) }
1934
1935 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1936          : tv_bndr tv_bndrs             { $1 : $2 }
1937          | {- empty -}                  { [] }
1938
1939 tv_bndr :: { LHsTyVarBndr RdrName }
1940         : tyvar                         { sL1 $1 (UserTyVar $1) }
1941         | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar $2 $4))
1942                                                [mop $1,mu AnnDcolon $3
1943                                                ,mcp $5] }
1944
1945 fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
1946         : {- empty -}                   { noLoc ([],[]) }
1947         | '|' fds1                      { (sLL $1 $> ([mj AnnVbar $1]
1948                                                  ,reverse (unLoc $2))) }
1949
1950 fds1 :: { Located [Located (FunDep (Located RdrName))] }
1951         : fds1 ',' fd   {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2)
1952                            >> return (sLL $1 $> ($3 : unLoc $1)) }
1953         | fd            { sL1 $1 [$1] }
1954
1955 fd :: { Located (FunDep (Located RdrName)) }
1956         : varids0 '->' varids0  {% ams (L (comb3 $1 $2 $3)
1957                                        (reverse (unLoc $1), reverse (unLoc $3)))
1958                                        [mu AnnRarrow $2] }
1959
1960 varids0 :: { Located [Located RdrName] }
1961         : {- empty -}                   { noLoc [] }
1962         | varids0 tyvar                 { sLL $1 $> ($2 : unLoc $1) }
1963
1964 {-
1965 Note [Parsing ~]
1966 ~~~~~~~~~~~~~~~~
1967
1968 Due to parsing conflicts between laziness annotations in data type
1969 declarations (see strict_mark) and equality types ~'s are always
1970 parsed as laziness annotations, and turned into HsEqTy's in the
1971 correct places using RdrHsSyn.splitTilde.
1972
1973 Since strict_mark is parsed as part of atype which is part of type,
1974 typedoc and context (where HsEqTy previously appeared) it made most
1975 sense and was simplest to parse ~ as part of strict_mark and later
1976 turn them into HsEqTy's.
1977
1978 -}
1979
1980
1981 -----------------------------------------------------------------------------
1982 -- Kinds
1983
1984 kind :: { LHsKind RdrName }
1985         : ctype                  { $1 }
1986
1987 {- Note [Promotion]
1988    ~~~~~~~~~~~~~~~~
1989
1990 - Syntax of promoted qualified names
1991 We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
1992 names. Moreover ticks are only allowed in types, not in kinds, for a
1993 few reasons:
1994   1. we don't need quotes since we cannot define names in kinds
1995   2. if one day we merge types and kinds, tick would mean look in DataName
1996   3. we don't have a kind namespace anyway
1997
1998 - Name resolution
1999 When the user write Zero instead of 'Zero in types, we parse it a
2000 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
2001 deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
2002 bounded in the type level, then we look for it in the term level (we
2003 change its namespace to DataName, see Note [Demotion] in OccName). And
2004 both become a HsTyVar ("Zero", DataName) after the renamer.
2005
2006 -}
2007
2008
2009 -----------------------------------------------------------------------------
2010 -- Datatype declarations
2011
2012 gadt_constrlist :: { Located ([AddAnn]
2013                           ,[LConDecl RdrName]) } -- Returned in order
2014         : 'where' '{'        gadt_constrs '}'   { L (comb2 $1 $3)
2015                                                     ([mj AnnWhere $1
2016                                                      ,moc $2
2017                                                      ,mcc $4]
2018                                                     , unLoc $3) }
2019         | 'where' vocurly    gadt_constrs close  { L (comb2 $1 $3)
2020                                                      ([mj AnnWhere $1]
2021                                                      , unLoc $3) }
2022         | {- empty -}                            { noLoc ([],[]) }
2023
2024 gadt_constrs :: { Located [LConDecl RdrName] }
2025         : gadt_constr_with_doc ';' gadt_constrs
2026                   {% addAnnotation (gl $1) AnnSemi (gl $2)
2027                      >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
2028         | gadt_constr_with_doc          { L (gl $1) [$1] }
2029         | {- empty -}                   { noLoc [] }
2030
2031 -- We allow the following forms:
2032 --      C :: Eq a => a -> T a
2033 --      C :: forall a. Eq a => !a -> T a
2034 --      D { x,y :: a } :: T a
2035 --      forall a. Eq a => D { x,y :: a } :: T a
2036
2037 gadt_constr_with_doc :: { LConDecl RdrName }
2038 gadt_constr_with_doc
2039         : maybe_docnext ';' gadt_constr
2040                 {% return $ addConDoc $3 $1 }
2041         | gadt_constr
2042                 {% return $1 }
2043
2044 gadt_constr :: { LConDecl RdrName }
2045     -- see Note [Difference in parsing GADT and data constructors]
2046     -- Returns a list because of:   C,D :: ty
2047         : con_list '::' sigtype
2048                 {% ams (sLL $1 $> (mkGadtDecl (unLoc $1) (mkLHsSigType $3)))
2049                        [mu AnnDcolon $2] }
2050
2051 {- Note [Difference in parsing GADT and data constructors]
2052 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2053 GADT constructors have simpler syntax than usual data constructors:
2054 in GADTs, types cannot occur to the left of '::', so they cannot be mixed
2055 with constructor names (see Note [Parsing data constructors is hard]).
2056
2057 Due to simplified syntax, GADT constructor names (left-hand side of '::')
2058 use simpler grammar production than usual data constructor names. As a
2059 consequence, GADT constructor names are resticted (names like '(*)' are
2060 allowed in usual data constructors, but not in GADTs).
2061 -}
2062
2063 constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
2064         : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
2065                                                      ,addConDocs (unLoc $3) $1)}
2066
2067 constrs1 :: { Located [LConDecl RdrName] }
2068         : constrs1 maybe_docnext '|' maybe_docprev constr
2069             {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
2070                >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
2071         | constr                                          { sL1 $1 [$1] }
2072
2073 constr :: { LConDecl RdrName }
2074         : maybe_docnext forall context_no_ops '=>' constr_stuff maybe_docprev
2075                 {% ams (let (con,details) = unLoc $5 in
2076                   addConDoc (L (comb4 $2 $3 $4 $5) (mkConDeclH98 con
2077                                                    (snd $ unLoc $2) $3 details))
2078                             ($1 `mplus` $6))
2079                         (mu AnnDarrow $4:(fst $ unLoc $2)) }
2080         | maybe_docnext forall constr_stuff maybe_docprev
2081                 {% ams ( let (con,details) = unLoc $3 in
2082                   addConDoc (L (comb2 $2 $3) (mkConDeclH98 con
2083                                            (snd $ unLoc $2) (noLoc []) details))
2084                             ($1 `mplus` $4))
2085                        (fst $ unLoc $2) }
2086
2087 forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr RdrName]) }
2088         : 'forall' tv_bndrs '.'       { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }
2089         | {- empty -}                 { noLoc ([], Nothing) }
2090
2091 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
2092     -- See Note [Parsing data constructors is hard] in RdrHsSyn
2093         : btype_no_ops                         {% do { c <- splitCon $1
2094                                                      ; return $ sLL $1 $> c } }
2095         | btype_no_ops conop btype_no_ops      {% do { ty <- splitTilde $1
2096                                                      ; return $ sLL $1 $> ($2, InfixCon ty $3) } }
2097
2098 fielddecls :: { [LConDeclField RdrName] }
2099         : {- empty -}     { [] }
2100         | fielddecls1     { $1 }
2101
2102 fielddecls1 :: { [LConDeclField RdrName] }
2103         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
2104             {% addAnnotation (gl $1) AnnComma (gl $3) >>
2105                return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
2106         | fielddecl   { [$1] }
2107
2108 fielddecl :: { LConDeclField RdrName }
2109                                               -- A list because of   f,g :: Int
2110         : maybe_docnext sig_vars '::' ctype maybe_docprev
2111             {% ams (L (comb2 $2 $4)
2112                       (ConDeclField (reverse (map (\ln@(L l n) -> L l $ FieldOcc ln PlaceHolder) (unLoc $2))) $4 ($1 `mplus` $5)))
2113                    [mu AnnDcolon $3] }
2114
2115 -- Reversed!
2116 maybe_derivings :: { HsDeriving RdrName }
2117         : {- empty -}             { noLoc [] }
2118         | derivings               { $1 }
2119
2120 -- A list of one or more deriving clauses at the end of a datatype
2121 derivings :: { HsDeriving RdrName }
2122         : derivings deriving      { sLL $1 $> $ $2 : unLoc $1 }
2123         | deriving                { sLL $1 $> [$1] }
2124
2125 -- The outer Located is just to allow the caller to
2126 -- know the rightmost extremity of the 'deriving' clause
2127 deriving :: { LHsDerivingClause RdrName }
2128         : 'deriving' deriv_strategy qtycondoc
2129               {% let { full_loc = comb2 $1 $> }
2130                  in ams (L full_loc $ HsDerivingClause $2 $ L full_loc
2131                             [mkLHsSigType $3])
2132                         [mj AnnDeriving $1] }
2133
2134         | 'deriving' deriv_strategy '(' ')'
2135               {% let { full_loc = comb2 $1 $> }
2136                  in ams (L full_loc $ HsDerivingClause $2 $ L full_loc [])
2137                         [mj AnnDeriving $1,mop $3,mcp $4] }
2138
2139         | 'deriving' deriv_strategy '(' deriv_types ')'
2140               {% let { full_loc = comb2 $1 $> }
2141                  in ams (L full_loc $ HsDerivingClause $2 $ L full_loc $4)
2142                         [mj AnnDeriving $1,mop $3,mcp $5] }
2143              -- Glasgow extension: allow partial
2144              -- applications in derivings
2145
2146 -----------------------------------------------------------------------------
2147 -- Value definitions
2148
2149 {- Note [Declaration/signature overlap]
2150 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2151 There's an awkward overlap with a type signature.  Consider
2152         f :: Int -> Int = ...rhs...
2153    Then we can't tell whether it's a type signature or a value
2154    definition with a result signature until we see the '='.
2155    So we have to inline enough to postpone reductions until we know.
2156 -}
2157
2158 {-
2159   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
2160   instead of qvar, we get another shift/reduce-conflict. Consider the
2161   following programs:
2162
2163      { (^^) :: Int->Int ; }          Type signature; only var allowed
2164
2165      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
2166                                      qvar allowed (because of instance decls)
2167
2168   We can't tell whether to reduce var to qvar until after we've read the signatures.
2169 -}
2170
2171 docdecl :: { LHsDecl RdrName }
2172         : docdecld { sL1 $1 (DocD (unLoc $1)) }
2173
2174 docdecld :: { LDocDecl }
2175         : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
2176         | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
2177         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
2178         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
2179
2180 decl_no_th :: { LHsDecl RdrName }
2181         : sigdecl               { $1 }
2182
2183         | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2) };
2184                                         pat <- checkPattern empty e;
2185                                         _ <- ams (sLL $1 $> ())
2186                                                (fst $ unLoc $3);
2187                                         return $ sLL $1 $> $ ValD $
2188                                             PatBind pat (snd $ unLoc $3)
2189                                                     placeHolderType
2190                                                     placeHolderNames
2191                                                     ([],[]) } }
2192                                 -- Turn it all into an expression so that
2193                                 -- checkPattern can check that bangs are enabled
2194
2195         | infixexp_top opt_sig rhs  {% do { (ann,r) <- checkValDef empty $1 (snd $2) $3;
2196                                         let { l = comb2 $1 $> };
2197                                         case r of {
2198                                           (FunBind n _ _ _ _) ->
2199                                                 ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
2200                                           (PatBind (L lh _lhs) _rhs _ _ _) ->
2201                                                 ams (L lh ()) (fst $2) >> return () } ;
2202                                         _ <- ams (L l ()) (ann ++ (fst $ unLoc $3));
2203                                         return $! (sL l $ ValD r) } }
2204         | pattern_synonym_decl  { $1 }
2205         | docdecl               { $1 }
2206
2207 decl    :: { LHsDecl RdrName }
2208         : decl_no_th            { $1 }
2209
2210         -- Why do we only allow naked declaration splices in top-level
2211         -- declarations and not here? Short answer: because readFail009
2212         -- fails terribly with a panic in cvBindsAndSigs otherwise.
2213         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
2214
2215 rhs     :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2216         : '=' exp wherebinds    { sL (comb3 $1 $2 $3)
2217                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
2218                                     ,GRHSs (unguardedRHS (comb3 $1 $2 $3) $2)
2219                                    (snd $ unLoc $3)) }
2220         | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
2221                                     ,GRHSs (reverse (unLoc $1))
2222                                                     (snd $ unLoc $2)) }
2223
2224 gdrhs :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2225         : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
2226         | gdrh                  { sL1 $1 [$1] }
2227
2228 gdrh :: { LGRHS RdrName (LHsExpr RdrName) }
2229         : '|' guardquals '=' exp  {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2230                                          [mj AnnVbar $1,mj AnnEqual $3] }
2231
2232 sigdecl :: { LHsDecl RdrName }
2233         :
2234         -- See Note [Declaration/signature overlap] for why we need infixexp here
2235           infixexp_top '::' sigtypedoc
2236                         {% do v <- checkValSigLhs $1
2237                         ; _ <- ams (sLL $1 $> ()) [mu AnnDcolon $2]
2238                         ; return (sLL $1 $> $ SigD $
2239                                   TypeSig [v] (mkLHsSigWcType $3)) }
2240
2241         | var ',' sig_vars '::' sigtypedoc
2242            {% do { let sig = TypeSig ($1 : reverse (unLoc $3))
2243                                      (mkLHsSigWcType $5)
2244                  ; addAnnotation (gl $1) AnnComma (gl $2)
2245                  ; ams ( sLL $1 $> $ SigD sig )
2246                        [mu AnnDcolon $4] } }
2247
2248         | infix prec ops
2249               {% ams (sLL $1 $> $ SigD
2250                         (FixSig (FixitySig (fromOL $ unLoc $3)
2251                                 (Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1)))))
2252                      [mj AnnInfix $1,mj AnnVal $2] }
2253
2254         | pattern_synonym_sig   { sLL $1 $> . SigD . unLoc $ $1 }
2255
2256         | '{-# COMPLETE' con_list opt_tyconsig  '#-}'
2257                 {% let (dcolon, tc) = $3
2258                    in ams
2259                        (sLL $1 $>
2260                          (SigD (CompleteMatchSig (getCOMPLETE_PRAGs $1) $2 tc)))
2261                     ([ mo $1 ] ++ dcolon ++ [mc $4]) }
2262
2263         -- This rule is for both INLINE and INLINABLE pragmas
2264         | '{-# INLINE' activation qvar '#-}'
2265                 {% ams ((sLL $1 $> $ SigD (InlineSig $3
2266                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
2267                                             (snd $2)))))
2268                        ((mo $1:fst $2) ++ [mc $4]) }
2269
2270         | '{-# SCC' qvar '#-}'
2271           {% ams (sLL $1 $> (SigD (SCCFunSig (getSCC_PRAGs $1) $2 Nothing)))
2272                  [mo $1, mc $3] }
2273
2274         | '{-# SCC' qvar STRING '#-}'
2275           {% do { scc <- getSCC $3
2276                 ; let str_lit = StringLiteral (getSTRINGs $3) scc
2277                 ; ams (sLL $1 $> (SigD (SCCFunSig (getSCC_PRAGs $1) $2 (Just str_lit))))
2278                       [mo $1, mc $4] } }
2279
2280         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
2281              {% ams (
2282                  let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
2283                                              (EmptyInlineSpec, FunLike) (snd $2)
2284                   in sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag))
2285                     (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
2286
2287         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
2288              {% ams (sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
2289                                (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
2290                                                (getSPEC_INLINE $1) (snd $2))))
2291                        (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
2292
2293         | '{-# SPECIALISE' 'instance' inst_type '#-}'
2294                 {% ams (sLL $1 $>
2295                                   $ SigD (SpecInstSig (getSPEC_PRAGs $1) $3))
2296                        [mo $1,mj AnnInstance $2,mc $4] }
2297
2298         -- A minimal complete definition
2299         | '{-# MINIMAL' name_boolformula_opt '#-}'
2300             {% ams (sLL $1 $> $ SigD (MinimalSig (getMINIMAL_PRAGs $1) $2))
2301                    [mo $1,mc $3] }
2302
2303 activation :: { ([AddAnn],Maybe Activation) }
2304         : {- empty -}                           { ([],Nothing) }
2305         | explicit_activation                   { (fst $1,Just (snd $1)) }
2306
2307 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
2308         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
2309                                   ,ActiveAfter  (getINTEGERs $2) (fromInteger (getINTEGER $2))) }
2310         | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
2311                                                  ,mj AnnCloseS $4]
2312                                   ,ActiveBefore (getINTEGERs $3) (fromInteger (getINTEGER $3))) }
2313
2314 -----------------------------------------------------------------------------
2315 -- Expressions
2316
2317 quasiquote :: { Located (HsSplice RdrName) }
2318         : TH_QUASIQUOTE   { let { loc = getLoc $1
2319                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
2320                                 ; quoterId = mkUnqual varName quoter }
2321                             in sL1 $1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2322         | TH_QQUASIQUOTE  { let { loc = getLoc $1
2323                                 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
2324                                 ; quoterId = mkQual varName (qual, quoter) }
2325                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2326
2327 exp   :: { LHsExpr RdrName }
2328         : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 (mkLHsSigWcType $3))
2329                                        [mu AnnDcolon $2] }
2330         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2331                                                         HsFirstOrderApp True)
2332                                        [mu Annlarrowtail $2] }
2333         | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2334                                                       HsFirstOrderApp False)
2335                                        [mu Annrarrowtail $2] }
2336         | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2337                                                       HsHigherOrderApp True)
2338                                        [mu AnnLarrowtail $2] }
2339         | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2340                                                       HsHigherOrderApp False)
2341                                        [mu AnnRarrowtail $2] }
2342         | infixexp              { $1 }
2343
2344 infixexp :: { LHsExpr RdrName }
2345         : exp10 { $1 }
2346         | infixexp qop exp10  {% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
2347                                      [mj AnnVal $2] }
2348                  -- AnnVal annotation for NPlusKPat, which discards the operator
2349
2350 infixexp_top :: { LHsExpr RdrName }
2351         : exp10_top               { $1 }
2352         | infixexp_top qop exp10_top
2353                                   {% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
2354                                          [mj AnnVal $2] }
2355
2356 exp10_top :: { LHsExpr RdrName }
2357         : '\\' apat apats opt_asig '->' exp
2358                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
2359                             [sLL $1 $> $ Match { m_ctxt = LambdaExpr
2360                                                , m_pats = $2:$3
2361                                                , m_type = snd $4
2362                                                , m_grhss = unguardedGRHSs $6 }]))
2363                           (mj AnnLam $1:mu AnnRarrow $5:(fst $4)) }
2364
2365         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
2366                                                (mj AnnLet $1:mj AnnIn $3
2367                                                  :(fst $ unLoc $2)) }
2368         | '\\' 'lcase' altslist
2369             {% ams (sLL $1 $> $ HsLamCase
2370                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
2371                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
2372         | 'if' exp optSemi 'then' exp optSemi 'else' exp
2373                            {% checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
2374                               ams (sLL $1 $> $ mkHsIf $2 $5 $8)
2375                                   (mj AnnIf $1:mj AnnThen $4
2376                                      :mj AnnElse $7
2377                                      :(map (\l -> mj AnnSemi l) (fst $3))
2378                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
2379         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
2380                                            ams (sLL $1 $> $ HsMultiIf
2381                                                      placeHolderType
2382                                                      (reverse $ snd $ unLoc $2))
2383                                                (mj AnnIf $1:(fst $ unLoc $2)) }
2384         | 'case' exp 'of' altslist      {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
2385                                                    FromSource (snd $ unLoc $4)))
2386                                                (mj AnnCase $1:mj AnnOf $3
2387                                                   :(fst $ unLoc $4)) }
2388         | '-' fexp                      {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
2389                                                [mj AnnMinus $1] }
2390
2391         | 'do' stmtlist              {% ams (L (comb2 $1 $2)
2392                                                (mkHsDo DoExpr (snd $ unLoc $2)))
2393                                                (mj AnnDo $1:(fst $ unLoc $2)) }
2394         | 'mdo' stmtlist            {% ams (L (comb2 $1 $2)
2395                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
2396                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
2397
2398         | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ fst $ unLoc $1)
2399                                                                 (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2400                                       (fst $ fst $ fst $ unLoc $1) }
2401
2402         | 'proc' aexp '->' exp
2403                        {% checkPattern empty $2 >>= \ p ->
2404                            checkCommand $4 >>= \ cmd ->
2405                            ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
2406                                                 placeHolderType []))
2407                                             -- TODO: is LL right here?
2408                                [mj AnnProc $1,mu AnnRarrow $3] }
2409
2410         | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4)
2411                                               [mo $1,mj AnnVal $2
2412                                               ,mc $3] }
2413                                           -- hdaume: core annotation
2414         | fexp                         { $1 }
2415
2416 exp10 :: { LHsExpr RdrName }
2417         : exp10_top            { $1 }
2418         | scc_annot exp        {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2419                                       (fst $ fst $ unLoc $1) }
2420
2421 optSemi :: { ([Located a],Bool) }
2422         : ';'         { ([$1],True) }
2423         | {- empty -} { ([],False) }
2424
2425 scc_annot :: { Located (([AddAnn],SourceText),StringLiteral) }
2426         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
2427                                             ; return $ sLL $1 $>
2428                                                (([mo $1,mj AnnValStr $2
2429                                                 ,mc $3],getSCC_PRAGs $1),(StringLiteral (getSTRINGs $2) scc)) }
2430         | '{-# SCC' VARID  '#-}'      { sLL $1 $> (([mo $1,mj AnnVal $2
2431                                          ,mc $3],getSCC_PRAGs $1)
2432                                         ,(StringLiteral NoSourceText (getVARID $2))) }
2433
2434 hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))),
2435                          ((SourceText,SourceText),(SourceText,SourceText))
2436                        ) }
2437       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
2438                                       { sLL $1 $> $ ((([mo $1,mj AnnVal $2
2439                                               ,mj AnnVal $3,mj AnnColon $4
2440                                               ,mj AnnVal $5,mj AnnMinus $6
2441                                               ,mj AnnVal $7,mj AnnColon $8
2442                                               ,mj AnnVal $9,mc $10],
2443                                                 getGENERATED_PRAGs $1)
2444                                               ,((getStringLiteral $2)
2445                                                ,( fromInteger $ getINTEGER $3
2446                                                 , fromInteger $ getINTEGER $5
2447                                                 )
2448                                                ,( fromInteger $ getINTEGER $7
2449                                                 , fromInteger $ getINTEGER $9
2450                                                 )
2451                                                ))
2452                                              , (( getINTEGERs $3
2453                                                 , getINTEGERs $5
2454                                                 )
2455                                                ,( getINTEGERs $7
2456                                                 , getINTEGERs $9
2457                                                 )))
2458                                          }
2459
2460 fexp    :: { LHsExpr RdrName }
2461         : fexp aexp                  { sLL $1 $> $ HsApp $1 $2 }
2462         | fexp TYPEAPP atype         {% ams (sLL $1 $> $ HsAppType $1 (mkHsWildCardBndrs $3))
2463                                             [mj AnnAt $2] }
2464         | 'static' aexp              {% ams (sLL $1 $> $ HsStatic placeHolderNames $2)
2465                                             [mj AnnStatic $1] }
2466         | aexp                       { $1 }
2467
2468 aexp    :: { LHsExpr RdrName }
2469         : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
2470             -- If you change the parsing, make sure to understand
2471             -- Note [Lexing type applications] in Lexer.x
2472
2473         | '~' aexp              {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
2474         | aexp1                 { $1 }
2475
2476 aexp1   :: { LHsExpr RdrName }
2477         : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
2478                                                                    (snd $3)
2479                                      ; _ <- ams (sLL $1 $> ()) (moc $2:mcc $4:(fst $3))
2480                                      ; checkRecordSyntax (sLL $1 $> r) }}
2481         | aexp2                { $1 }
2482
2483 aexp2   :: { LHsExpr RdrName }
2484         : qvar                          { sL1 $1 (HsVar   $! $1) }
2485         | qcon                          { sL1 $1 (HsVar   $! $1) }
2486         | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
2487         | overloaded_label              { sL1 $1 (HsOverLabel $! unLoc $1) }
2488         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
2489 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
2490 -- into HsOverLit when -foverloaded-strings is on.
2491 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
2492 --                                       (getSTRING $1) placeHolderType) }
2493         | INTEGER   { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGERs $1)
2494                                          (getINTEGER $1) placeHolderType) }
2495         | RATIONAL  { sL (getLoc $1) (HsOverLit $! mkHsFractional
2496                                           (getRATIONAL $1) placeHolderType) }
2497
2498         -- N.B.: sections get parsed by these next two productions.
2499         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
2500         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
2501         -- but the less cluttered version fell out of having texps.
2502         | '(' texp ')'                  {% ams (sLL $1 $> (HsPar $2)) [mop $1,mcp $3] }
2503         | '(' tup_exprs ')'             {% do { e <- mkSumOrTuple Boxed (comb2 $1 $3) (snd $2)
2504                                               ; ams (sLL $1 $> e) ((mop $1:fst $2) ++ [mcp $3]) } }
2505
2506         | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple [L (gl $2)
2507                                                          (Present $2)] Unboxed))
2508                                                [mo $1,mc $3] }
2509         | '(#' tup_exprs '#)'           {% do { e <- mkSumOrTuple Unboxed (comb2 $1 $3) (snd $2)
2510                                               ; ams (sLL $1 $> e) ((mo $1:fst $2) ++ [mc $3]) } }
2511
2512         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
2513         | '[:' parr ':]'    {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
2514         | '_'               { sL1 $1 EWildPat }
2515
2516         -- Template Haskell Extension
2517         | splice_exp            { $1 }
2518
2519         | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2520         | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2521         | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2522         | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2523         | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2))
2524                                       (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
2525         | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2))
2526                                       (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
2527         | '[t|' ctype '|]'    {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
2528         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
2529                                       ams (sLL $1 $> $ HsBracket (PatBr p))
2530                                           [mo $1,mc $3] }
2531         | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
2532                                       (mo $1:mc $3:fst $2) }
2533         | quasiquote          { sL1 $1 (HsSpliceE (unLoc $1)) }
2534
2535         -- arrow notation extension
2536         | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm $2
2537                                                            Nothing (reverse $3))
2538                                           [mo $1,mc $4] }
2539
2540 splice_exp :: { LHsExpr RdrName }
2541         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkHsSpliceE NoParens
2542                                         (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
2543                                                            (getTH_ID_SPLICE $1)))))
2544                                        [mj AnnThIdSplice $1] }
2545         | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE HasParens $2)
2546                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
2547         | TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkHsSpliceTE NoParens
2548                                         (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
2549                                                         (getTH_ID_TY_SPLICE $1)))))
2550                                        [mj AnnThIdTySplice $1] }
2551         | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE HasParens $2)
2552                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
2553
2554 cmdargs :: { [LHsCmdTop RdrName] }
2555         : cmdargs acmd                  { $2 : $1 }
2556         | {- empty -}                   { [] }
2557
2558 acmd    :: { LHsCmdTop RdrName }
2559         : aexp2                 {% checkCommand $1 >>= \ cmd ->
2560                                     return (sL1 $1 $ HsCmdTop cmd
2561                                            placeHolderType placeHolderType []) }
2562
2563 cvtopbody :: { ([AddAnn],[LHsDecl RdrName]) }
2564         :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1
2565                                                   ,mj AnnCloseC $3],$2) }
2566         |      vocurly    cvtopdecls0 close    { ([],$2) }
2567
2568 cvtopdecls0 :: { [LHsDecl RdrName] }
2569         : topdecls_semi         { cvTopDecls $1 }
2570         | topdecls              { cvTopDecls $1 }
2571
2572 -----------------------------------------------------------------------------
2573 -- Tuple expressions
2574
2575 -- "texp" is short for tuple expressions:
2576 -- things that can appear unparenthesized as long as they're
2577 -- inside parens or delimitted by commas
2578 texp :: { LHsExpr RdrName }
2579         : exp                           { $1 }
2580
2581         -- Note [Parsing sections]
2582         -- ~~~~~~~~~~~~~~~~~~~~~~~
2583         -- We include left and right sections here, which isn't
2584         -- technically right according to the Haskell standard.
2585         -- For example (3 +, True) isn't legal.
2586         -- However, we want to parse bang patterns like
2587         --      (!x, !y)
2588         -- and it's convenient to do so here as a section
2589         -- Then when converting expr to pattern we unravel it again
2590         -- Meanwhile, the renamer checks that real sections appear
2591         -- inside parens.
2592         | infixexp qop        { sLL $1 $> $ SectionL $1 $2 }
2593         | qopm infixexp       { sLL $1 $> $ SectionR $1 $2 }
2594
2595        -- View patterns get parenthesized above
2596         | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mu AnnRarrow $2] }
2597
2598 -- Always at least one comma or bar.
2599 tup_exprs :: { ([AddAnn],SumOrTuple) }
2600            : texp commas_tup_tail
2601                           {% do { addAnnotation (gl $1) AnnComma (fst $2)
2602                                 ; return ([],Tuple ((sL1 $1 (Present $1)) : snd $2)) } }
2603
2604            | texp bars    { (mvbars (fst $2), Sum 1  (snd $2 + 1) $1) }
2605
2606            | commas tup_tail
2607                 {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
2608                       ; return
2609                            ([],Tuple (map (\l -> L l missingTupArg) (fst $1) ++ $2)) } }
2610
2611            | bars texp bars0
2612                 { (mvbars (fst $1) ++ mvbars (fst $3), Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2) }
2613
2614 -- Always starts with commas; always follows an expr
2615 commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) }
2616 commas_tup_tail : commas tup_tail
2617        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
2618              ; return (
2619             (head $ fst $1
2620             ,(map (\l -> L l missingTupArg) (tail $ fst $1)) ++ $2)) } }
2621
2622 -- Always follows a comma
2623 tup_tail :: { [LHsTupArg RdrName] }
2624           : texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
2625                                     return ((L (gl $1) (Present $1)) : snd $2) }
2626           | texp                 { [L (gl $1) (Present $1)] }
2627           | {- empty -}          { [noLoc missingTupArg] }
2628
2629 -----------------------------------------------------------------------------
2630 -- List expressions
2631
2632 -- The rules below are little bit contorted to keep lexps left-recursive while
2633 -- avoiding another shift/reduce-conflict.
2634 list :: { ([AddAnn],HsExpr RdrName) }
2635         : texp    { ([],ExplicitList placeHolderType Nothing [$1]) }
2636         | lexps   { ([],ExplicitList placeHolderType Nothing
2637                                                    (reverse (unLoc $1))) }
2638         | texp '..'             { ([mj AnnDotdot $2],
2639                                       ArithSeq noPostTcExpr Nothing (From $1)) }
2640         | texp ',' exp '..'     { ([mj AnnComma $2,mj AnnDotdot $4],
2641                                   ArithSeq noPostTcExpr Nothing
2642                                                              (FromThen $1 $3)) }
2643         | texp '..' exp         { ([mj AnnDotdot $2],
2644                                    ArithSeq noPostTcExpr Nothing
2645                                                                (FromTo $1 $3)) }
2646         | texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
2647                                     ArithSeq noPostTcExpr Nothing
2648                                                 (FromThenTo $1 $3 $5)) }
2649         | texp '|' flattenedpquals
2650              {% checkMonadComp >>= \ ctxt ->
2651                 return ([mj AnnVbar $2],
2652                         mkHsComp ctxt (unLoc $3) $1) }
2653
2654 lexps :: { Located [LHsExpr RdrName] }
2655         : lexps ',' texp          {% addAnnotation (gl $ head $ unLoc $1)
2656                                                             AnnComma (gl $2) >>
2657                                       return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
2658         | texp ',' texp            {% addAnnotation (gl $1) AnnComma (gl $2) >>
2659                                       return (sLL $1 $> [$3,$1]) }
2660
2661 -----------------------------------------------------------------------------
2662 -- List Comprehensions
2663
2664 flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2665     : pquals   { case (unLoc $1) of
2666                     [qs] -> sL1 $1 qs
2667                     -- We just had one thing in our "parallel" list so
2668                     -- we simply return that thing directly
2669
2670                     qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock qs [] noSyntaxExpr |
2671                                             qs <- qss]
2672                                             noExpr noSyntaxExpr placeHolderType]
2673                     -- We actually found some actual parallel lists so
2674                     -- we wrap them into as a ParStmt
2675                 }
2676
2677 pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] }
2678     : squals '|' pquals
2679                      {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
2680                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
2681     | squals         { L (getLoc $1) [reverse (unLoc $1)] }
2682
2683 squals :: { Located [LStmt RdrName (LHsExpr RdrName)] }   -- In reverse order, because the last
2684                                         -- one can "grab" the earlier ones
2685     : squals ',' transformqual
2686              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2687                 ams (sLL $1 $> ()) (fst $ unLoc $3) >>
2688                 return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
2689     | squals ',' qual
2690              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2691                 return (sLL $1 $> ($3 : unLoc $1)) }
2692     | transformqual        {% ams $1 (fst $ unLoc $1) >>
2693                               return (sLL $1 $> [L (getLoc $1) ((snd $ unLoc $1) [])]) }
2694     | qual                                { sL1 $1 [$1] }
2695 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
2696 --  | '{|' pquals '|}'                       { sL1 $1 [$2] }
2697
2698 -- It is possible to enable bracketing (associating) qualifier lists
2699 -- by uncommenting the lines with {| |} above. Due to a lack of
2700 -- consensus on the syntax, this feature is not being used until we
2701 -- get user demand.
2702
2703 transformqual :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)] -> Stmt RdrName (LHsExpr RdrName)) }
2704                         -- Function is applied to a list of stmts *in order*
2705     : 'then' exp               { sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
2706     | 'then' exp 'by' exp      { sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],\ss -> (mkTransformByStmt ss $2 $4)) }
2707     | 'then' 'group' 'using' exp
2708              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3], \ss -> (mkGroupUsingStmt ss $4)) }
2709
2710     | 'then' 'group' 'by' exp 'using' exp
2711              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5], \ss -> (mkGroupByUsingStmt ss $4 $6)) }
2712
2713 -- Note that 'group' is a special_id, which means that you can enable
2714 -- TransformListComp while still using Data.List.group. However, this
2715 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
2716 -- in by choosing the "group by" variant, which is what we want.
2717
2718 -----------------------------------------------------------------------------
2719 -- Parallel array expressions
2720
2721 -- The rules below are little bit contorted; see the list case for details.
2722 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
2723 -- Moreover, we allow explicit arrays with no element (represented by the nil
2724 -- constructor in the list case).
2725
2726 parr :: { ([AddAnn],HsExpr RdrName) }
2727         :                      { ([],ExplicitPArr placeHolderType []) }
2728         | texp                 { ([],ExplicitPArr placeHolderType [$1]) }
2729         | lexps                { ([],ExplicitPArr placeHolderType
2730                                                           (reverse (unLoc $1))) }
2731         | texp '..' exp        { ([mj AnnDotdot $2]
2732                                  ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
2733         | texp ',' exp '..' exp
2734                         { ([mj AnnComma $2,mj AnnDotdot $4]
2735                           ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
2736         | texp '|' flattenedpquals
2737                         { ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
2738
2739 -- We are reusing `lexps' and `flattenedpquals' from the list case.
2740
2741 -----------------------------------------------------------------------------
2742 -- Guards
2743
2744 guardquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2745     : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
2746
2747 guardquals1 :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2748     : guardquals1 ',' qual  {% addAnnotation (gl $ head $ unLoc $1) AnnComma
2749                                              (gl $2) >>
2750                                return (sLL $1 $> ($3 : unLoc $1)) }
2751     | qual                  { sL1 $1 [$1] }
2752
2753 -----------------------------------------------------------------------------
2754 -- Case alternatives
2755
2756 altslist :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2757         : '{'            alts '}'  { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2758                                                ,(reverse (snd $ unLoc $2))) }
2759         |     vocurly    alts  close { L (getLoc $2) (fst $ unLoc $2
2760                                         ,(reverse (snd $ unLoc $2))) }
2761         | '{'                 '}'    { noLoc ([moc $1,mcc $2],[]) }
2762         |     vocurly          close { noLoc ([],[]) }
2763
2764 alts    :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2765         : alts1                    { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
2766         | ';' alts                 { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
2767                                                ,snd $ unLoc $2) }
2768
2769 alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2770         : alts1 ';' alt         {% if null (snd $ unLoc $1)
2771                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2772                                                   ,[$3]))
2773                                      else (ams (head $ snd $ unLoc $1)
2774                                                (mj AnnSemi $2:(fst $ unLoc $1))
2775                                            >> return (sLL $1 $> ([],$3 : (snd $ unLoc $1))) ) }
2776         | alts1 ';'             {% if null (snd $ unLoc $1)
2777                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2778                                                   ,snd $ unLoc $1))
2779                                      else (ams (head $ snd $ unLoc $1)
2780                                                (mj AnnSemi $2:(fst $ unLoc $1))
2781                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
2782         | alt                   { sL1 $1 ([],[$1]) }
2783
2784 alt     :: { LMatch RdrName (LHsExpr RdrName) }
2785         : pat opt_asig alt_rhs  {%ams (sLL $1 $> (Match { m_ctxt = CaseAlt
2786                                                         , m_pats = [$1]
2787                                                         , m_type = snd $2
2788                                                         , m_grhss = snd $ unLoc $3 }))
2789                                       (fst $2 ++ (fst $ unLoc $3))}
2790
2791 alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2792         : ralt wherebinds           { sLL $1 $> (fst $ unLoc $2,
2793                                             GRHSs (unLoc $1) (snd $ unLoc $2)) }
2794
2795 ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2796         : '->' exp            {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
2797                                      [mu AnnRarrow $1] }
2798         | gdpats              { sL1 $1 (reverse (unLoc $1)) }
2799
2800 gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2801         : gdpats gdpat                  { sLL $1 $> ($2 : unLoc $1) }
2802         | gdpat                         { sL1 $1 [$1] }
2803
2804 -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
2805 -- generate the open brace in addition to the vertical bar in the lexer, and
2806 -- we don't need it.
2807 ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
2808          : '{' gdpats '}'                 { sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }
2809          |     gdpats close               { sL1 $1 ([],unLoc $1) }
2810
2811 gdpat   :: { LGRHS RdrName (LHsExpr RdrName) }
2812         : '|' guardquals '->' exp
2813                                   {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2814                                          [mj AnnVbar $1,mu AnnRarrow $3] }
2815
2816 -- 'pat' recognises a pattern, including one with a bang at the top
2817 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
2818 -- Bangs inside are parsed as infix operator applications, so that
2819 -- we parse them right when bang-patterns are off
2820 pat     :: { LPat RdrName }
2821 pat     :  exp          {% checkPattern empty $1 }
2822         | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR
2823                                                      (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
2824                                 [mj AnnBang $1] }
2825
2826 bindpat :: { LPat RdrName }
2827 bindpat :  exp            {% checkPattern
2828                                 (text "Possibly caused by a missing 'do'?") $1 }
2829         | '!' aexp        {% amms (checkPattern
2830                                      (text "Possibly caused by a missing 'do'?")
2831                                      (sLL $1 $> (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
2832                                   [mj AnnBang $1] }
2833
2834 apat   :: { LPat RdrName }
2835 apat    : aexp                  {% checkPattern empty $1 }
2836         | '!' aexp              {% amms (checkPattern empty
2837                                             (sLL $1 $> (SectionR
2838                                                 (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
2839                                         [mj AnnBang $1] }
2840
2841 apats  :: { [LPat RdrName] }
2842         : apat apats            { $1 : $2 }
2843         | {- empty -}           { [] }
2844
2845 -----------------------------------------------------------------------------
2846 -- Statement sequences
2847
2848 stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2849         : '{'           stmts '}'       { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2850                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
2851         |     vocurly   stmts close     { L (gl $2) (fst $ unLoc $2
2852                                                     ,reverse $ snd $ unLoc $2) }
2853
2854 --      do { ;; s ; s ; ; s ;; }
2855 -- The last Stmt should be an expression, but that's hard to enforce
2856 -- here, because we need too much lookahead if we see do { e ; }
2857 -- So we use BodyStmts throughout, and switch the last one over
2858 -- in ParseUtils.checkDo instead
2859
2860 stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2861         : stmts ';' stmt  {% if null (snd $ unLoc $1)
2862                               then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2863                                                      ,$3 : (snd $ unLoc $1)))
2864                               else do
2865                                { ams (head $ snd $ unLoc $1) [mj AnnSemi $2]
2866                                ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(snd $ unLoc $1)) }}
2867
2868         | stmts ';'     {% if null (snd $ unLoc $1)
2869                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1),snd $ unLoc $1))
2870                              else do
2871                                { ams (head $ snd $ unLoc $1)
2872                                                [mj AnnSemi $2]
2873                                ; return $1 } }
2874         | stmt                   { sL1 $1 ([],[$1]) }
2875         | {- empty -}            { noLoc ([],[]) }
2876
2877
2878 -- For typing stmts at the GHCi prompt, where
2879 -- the input may consist of just comments.
2880 maybe_stmt :: { Maybe (LStmt RdrName (LHsExpr RdrName)) }
2881         : stmt                          { Just $1 }
2882         | {- nothing -}                 { Nothing }
2883
2884 stmt  :: { LStmt RdrName (LHsExpr RdrName) }
2885         : qual                          { $1 }
2886         | 'rec' stmtlist                {% ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
2887                                                (mj AnnRec $1:(fst $ unLoc $2)) }
2888
2889 qual  :: { LStmt RdrName (LHsExpr RdrName) }
2890     : bindpat '<-' exp                  {% ams (sLL $1 $> $ mkBindStmt $1 $3)
2891                                                [mu AnnLarrow $2] }
2892     | exp                               { sL1 $1 $ mkBodyStmt $1 }
2893     | 'let' binds                       {% ams (sLL $1 $>$ LetStmt (snd $ unLoc $2))
2894                                                (mj AnnLet $1:(fst $ unLoc $2)) }
2895
2896 -----------------------------------------------------------------------------
2897 -- Record Field Update/Construction
2898
2899 fbinds  :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2900         : fbinds1                       { $1 }
2901         | {- empty -}                   { ([],([], False)) }
2902
2903 fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2904         : fbind ',' fbinds1
2905                 {% addAnnotation (gl $1) AnnComma (gl $2) >>
2906                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
2907         | fbind                         { ([],([$1], False)) }
2908         | '..'                          { ([mj AnnDotdot $1],([],   True)) }
2909
2910 fbind   :: { LHsRecField RdrName (LHsExpr RdrName) }
2911         : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
2912                                 [mj AnnEqual $2] }
2913                         -- RHS is a 'texp', allowing view patterns (Trac #6038)
2914                         -- and, incidentally, sections.  Eg
2915                         -- f (R { x = show -> s }) = ...
2916
2917         | qvar          { sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) placeHolderPunRhs True }
2918                         -- In the punning case, use a place-holder
2919                         -- The renamer fills in the final value
2920
2921 -----------------------------------------------------------------------------
2922 -- Implicit Parameter Bindings
2923
2924 dbinds  :: { Located [LIPBind RdrName] }
2925         : dbinds ';' dbind
2926                       {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2927                          return (let { this = $3; rest = unLoc $1 }
2928                               in rest `seq` this `seq` sLL $1 $> (this : rest)) }
2929         | dbinds ';'  {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2930                          return (sLL $1 $> (unLoc $1)) }
2931         | dbind                        { let this = $1 in this `seq` sL1 $1 [this] }
2932 --      | {- empty -}                  { [] }
2933
2934 dbind   :: { LIPBind RdrName }
2935 dbind   : ipvar '=' exp                {% ams (sLL $1 $> (IPBind (Left $1) $3))
2936                                               [mj AnnEqual $2] }
2937
2938 ipvar   :: { Located HsIPName }
2939         : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
2940
2941 -----------------------------------------------------------------------------
2942 -- Overloaded labels
2943
2944 overloaded_label :: { Located FastString }
2945         : LABELVARID          { sL1 $1 (getLABELVARID $1) }
2946
2947 -----------------------------------------------------------------------------
2948 -- Warnings and deprecations
2949
2950 name_boolformula_opt :: { LBooleanFormula (Located RdrName) }
2951         : name_boolformula          { $1 }
2952         | {- empty -}               { noLoc mkTrue }
2953
2954 name_boolformula :: { LBooleanFormula (Located RdrName) }
2955         : name_boolformula_and                      { $1 }
2956         | name_boolformula_and '|' name_boolformula
2957                            {% aa $1 (AnnVbar, $2)
2958                               >> return (sLL $1 $> (Or [$1,$3])) }
2959
2960 name_boolformula_and :: { LBooleanFormula (Located RdrName) }
2961         : name_boolformula_atom                             { $1 }
2962         | name_boolformula_atom ',' name_boolformula_and
2963                   {% aa $1 (AnnComma,$2) >> return (sLL $1 $> (And [$1,$3])) }
2964
2965 name_boolformula_atom :: { LBooleanFormula (Located RdrName) }
2966         : '(' name_boolformula ')'  {% ams (sLL $1 $> (Parens $2)) [mop $1,mcp $3] }
2967         | name_var                  { sL1 $1 (Var $1) }
2968
2969 namelist :: { Located [Located RdrName] }
2970 namelist : name_var              { sL1 $1 [$1] }
2971          | name_var ',' namelist {% addAnnotation (gl $1) AnnComma (gl $2) >>
2972                                     return (sLL $1 $> ($1 : unLoc $3)) }
2973
2974 name_var :: { Located RdrName }
2975 name_var : var { $1 }
2976          | con { $1 }
2977
2978 -----------------------------------------
2979 -- Data constructors
2980 -- There are two different productions here as lifted list constructors
2981 -- are parsed differently.
2982
2983 qcon_nowiredlist :: { Located RdrName }
2984         : gen_qcon                     { $1 }
2985         | sysdcon_nolist               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2986
2987 qcon :: { Located RdrName }
2988   : gen_qcon              { $1}
2989   | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2990
2991 gen_qcon :: { Located RdrName }
2992   : qconid                { $1 }
2993   | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))
2994                                    [mop $1,mj AnnVal $2,mcp $3] }
2995
2996 -- The case of '[:' ':]' is part of the production `parr'
2997
2998 con     :: { Located RdrName }
2999         : conid                 { $1 }
3000         | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))
3001                                        [mop $1,mj AnnVal $2,mcp $3] }
3002         | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
3003
3004 con_list :: { Located [Located RdrName] }
3005 con_list : con                  { sL1 $1 [$1] }
3006          | con ',' con_list     {% addAnnotation (gl $1) AnnComma (gl $2) >>
3007                                    return (sLL $1 $> ($1 : unLoc $3)) }
3008
3009 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
3010         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
3011         | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
3012                                        (mop $1:mcp $3:(mcommas (fst $2))) }
3013         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
3014         | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
3015                                        (mo $1:mc $3:(mcommas (fst $2))) }
3016
3017 sysdcon :: { Located DataCon }
3018         : sysdcon_nolist                 { $1 }
3019         | '[' ']'               {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] }
3020
3021 conop :: { Located RdrName }
3022         : consym                { $1 }
3023         | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2))
3024                                        [mj AnnBackquote $1,mj AnnVal $2
3025                                        ,mj AnnBackquote $3] }
3026
3027 qconop :: { Located RdrName }
3028         : qconsym               { $1 }
3029         | '`' qconid '`'        {% ams (sLL $1 $> (unLoc $2))
3030                                        [mj AnnBackquote $1,mj AnnVal $2
3031                                        ,mj AnnBackquote $3] }
3032
3033 ----------------------------------------------------------------------------
3034 -- Type constructors
3035
3036
3037 -- See Note [Unit tuples] in HsTypes for the distinction
3038 -- between gtycon and ntgtycon
3039 gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
3040         : ntgtycon                     { $1 }
3041         | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)
3042                                               [mop $1,mcp $2] }
3043         | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)
3044                                               [mo $1,mc $2] }
3045
3046 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
3047         : oqtycon               { $1 }
3048         | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
3049                                                         (snd $2 + 1)))
3050                                        (mop $1:mcp $3:(mcommas (fst $2))) }
3051         | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
3052                                                         (snd $2 + 1)))
3053                                        (mo $1:mc $3:(mcommas (fst $2))) }
3054         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
3055                                        [mop $1,mu AnnRarrow $2,mcp $3] }
3056         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
3057         | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
3058         | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
3059                                         [mop $1,mj AnnTildehsh $2,mcp $3] }
3060
3061 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
3062                                 -- These can appear in export lists
3063         : qtycon                        { $1 }
3064         | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2))
3065                                                [mop $1,mj AnnVal $2,mcp $3] }
3066         | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)
3067                                                [mop $1,mj AnnVal $2,mcp $3] }
3068
3069 oqtycon_no_varcon :: { Located RdrName }  -- Type constructor which cannot be mistaken
3070                                           -- for variable constructor in export lists
3071                                           -- see Note [Type constructors in export list]
3072         :  qtycon            { $1 }
3073         | '(' QCONSYM ')'    {% let name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2)
3074                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
3075         | '(' CONSYM ')'     {% let name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2)
3076                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
3077         | '(' ':' ')'        {% let name = sL1 $2 $! consDataCon_RDR
3078                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
3079         | '(' '~' ')'        {% ams (sLL $1 $> $ eqTyCon_RDR) [mop $1,mj AnnTilde $2,mcp $3] }
3080
3081 {- Note [Type constructors in export list]
3082 ~~~~~~~~~~~~~~~~~~~~~
3083 Mixing type constructors and data constructors in export lists introduces
3084 ambiguity in grammar: e.g. (*) may be both a type constructor and a function.
3085
3086 -XExplicitNamespaces allows to disambiguate by explicitly prefixing type
3087 constructors with 'type' keyword.
3088
3089 This ambiguity causes reduce/reduce conflicts in parser, which are always
3090 resolved in favour of data constructors. To get rid of conflicts we demand
3091 that ambiguous type constructors (those, which are formed by the same
3092 productions as variable constructors) are always prefixed with 'type' keyword.
3093 Unambiguous type constructors may occur both with or without 'type' keyword.
3094
3095 Note that in the parser we still parse data constructors as type
3096 constructors. As such, they still end up in the type constructor namespace
3097 until after renaming when we resolve the proper namespace for each exported
3098 child.
3099 -}
3100
3101 qtyconop :: { Located RdrName } -- Qualified or unqualified
3102         : qtyconsym                     { $1 }
3103         | '`' qtycon '`'                {% ams (sLL $1 $> (unLoc $2))
3104                                                [mj AnnBackquote $1,mj AnnVal $2
3105                                                ,mj AnnBackquote $3] }
3106
3107 qtycon :: { Located RdrName }   -- Qualified or unqualified
3108         : QCONID            { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
3109         | tycon             { $1 }
3110
3111 qtycondoc :: { LHsType RdrName } -- Qualified or unqualified
3112         : qtycon            { sL1 $1                     (HsTyVar NotPromoted $1)      }
3113         | qtycon docprev    { sLL $1 $> (HsDocTy (sL1 $1 (HsTyVar NotPromoted $1)) $2) }
3114
3115 tycon   :: { Located RdrName }  -- Unqualified
3116         : CONID                   { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
3117
3118 qtyconsym :: { Located RdrName }
3119         : QCONSYM            { sL1 $1 $! mkQual tcClsName (getQCONSYM $1) }
3120         | QVARSYM            { sL1 $1 $! mkQual tcClsName (getQVARSYM $1) }
3121         | tyconsym           { $1 }
3122
3123 -- Does not include "!", because that is used for strictness marks
3124 --               or ".", because that separates the quantified type vars from the rest
3125 tyconsym :: { Located RdrName }
3126         : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
3127         | VARSYM                { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
3128         | ':'                   { sL1 $1 $! consDataCon_RDR }
3129         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
3130
3131
3132 -----------------------------------------------------------------------------
3133 -- Operators
3134
3135 op      :: { Located RdrName }   -- used in infix decls
3136         : varop                 { $1 }
3137         | conop                 { $1 }
3138
3139 varop   :: { Located RdrName }
3140         : varsym                { $1 }
3141         | '`' varid '`'         {% ams (sLL $1 $> (unLoc $2))
3142                                        [mj AnnBackquote $1,mj AnnVal $2
3143                                        ,mj AnnBackquote $3] }
3144
3145 qop     :: { LHsExpr RdrName }   -- used in sections
3146         : qvarop                { sL1 $1 $ HsVar $1 }
3147         | qconop                { sL1 $1 $ HsVar $1 }
3148         | '`' '_' '`'           {% ams (sLL $1 $> EWildPat)
3149                                        [mj AnnBackquote $1,mj AnnVal $2
3150                                        ,mj AnnBackquote $3] }
3151
3152 qopm    :: { LHsExpr RdrName }   -- used in sections
3153         : qvaropm               { sL1 $1 $ HsVar $1 }
3154         | qconop                { sL1 $1 $ HsVar $1 }
3155
3156 qvarop :: { Located RdrName }
3157         : qvarsym               { $1 }
3158         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
3159                                        [mj AnnBackquote $1,mj AnnVal $2
3160                                        ,mj AnnBackquote $3] }
3161
3162 qvaropm :: { Located RdrName }
3163         : qvarsym_no_minus      { $1 }
3164         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
3165                                        [mj AnnBackquote $1,mj AnnVal $2
3166                                        ,mj AnnBackquote $3] }
3167
3168 -----------------------------------------------------------------------------
3169 -- Type variables
3170
3171 tyvar   :: { Located RdrName }
3172 tyvar   : tyvarid               { $1 }
3173
3174 tyvarop :: { Located RdrName }
3175 tyvarop : '`' tyvarid '`'       {% ams (sLL $1 $> (unLoc $2))
3176                                        [mj AnnBackquote $1,mj AnnVal $2
3177                                        ,mj AnnBackquote $3] }
3178         | '.'                   {% parseErrorSDoc (getLoc $1)
3179                                       (vcat [text "Illegal symbol '.' in type",
3180                                              text "Perhaps you intended to use RankNTypes or a similar language",
3181                                              text "extension to enable explicit-forall syntax: forall <tvs>. <type>"])
3182                                 }
3183
3184 tyvarid :: { Located RdrName }
3185         : VARID            { sL1 $1 $! mkUnqual tvName (getVARID $1) }
3186         | special_id       { sL1 $1 $! mkUnqual tvName (unLoc $1) }
3187         | 'unsafe'         { sL1 $1 $! mkUnqual tvName (fsLit "unsafe") }
3188         | 'safe'           { sL1 $1 $! mkUnqual tvName (fsLit "safe") }
3189         | 'interruptible'  { sL1 $1 $! mkUnqual tvName (fsLit "interruptible") }
3190
3191 -----------------------------------------------------------------------------
3192 -- Variables
3193
3194 var     :: { Located RdrName }
3195         : varid                 { $1 }
3196         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
3197                                        [mop $1,mj AnnVal $2,mcp $3] }
3198
3199  -- Lexing type applications depends subtly on what characters can possibly
3200  -- end a qvar. Currently (June 2015), only $idchars and ")" can end a qvar.
3201  -- If you're changing this, please see Note [Lexing type applications] in
3202  -- Lexer.x.
3203 qvar    :: { Located RdrName }
3204         : qvarid                { $1 }
3205         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
3206                                        [mop $1,mj AnnVal $2,mcp $3] }
3207         | '(' qvarsym1 ')'      {% ams (sLL $1 $> (unLoc $2))
3208                                        [mop $1,mj AnnVal $2,mcp $3] }
3209 -- We've inlined qvarsym here so that the decision about
3210 -- whether it's a qvar or a var can be postponed until
3211 -- *after* we see the close paren.
3212
3213 qvarid :: { Located RdrName }
3214         : varid               { $1 }
3215         | QVARID              { sL1 $1 $! mkQual varName (getQVARID $1) }
3216
3217 -- Note that 'role' and 'family' get lexed separately regardless of
3218 -- the use of extensions. However, because they are listed here,
3219 -- this is OK and they can be used as normal varids.
3220 -- See Note [Lexing type pseudo-keywords] in Lexer.x
3221 varid :: { Located RdrName }
3222         : VARID            { sL1 $1 $! mkUnqual varName (getVARID $1) }
3223         | special_id       { sL1 $1 $! mkUnqual varName (unLoc $1) }
3224         | 'unsafe'         { sL1 $1 $! mkUnqual varName (fsLit "unsafe") }
3225         | 'safe'           { sL1 $1 $! mkUnqual varName (fsLit "safe") }
3226         | 'interruptible'  { sL1 $1 $! mkUnqual varName (fsLit "interruptible")}
3227         | 'forall'         { sL1 $1 $! mkUnqual varName (fsLit "forall") }
3228         | 'family'         { sL1 $1 $! mkUnqual varName (fsLit "family") }
3229         | 'role'           { sL1 $1 $! mkUnqual varName (fsLit "role") }
3230
3231 qvarsym :: { Located RdrName }
3232         : varsym                { $1 }
3233         | qvarsym1              { $1 }
3234
3235 qvarsym_no_minus :: { Located RdrName }
3236         : varsym_no_minus       { $1 }
3237         | qvarsym1              { $1 }
3238
3239 qvarsym1 :: { Located RdrName }
3240 qvarsym1 : QVARSYM              { sL1 $1 $ mkQual varName (getQVARSYM $1) }
3241
3242 varsym :: { Located RdrName }
3243         : varsym_no_minus       { $1 }
3244         | '-'                   { sL1 $1 $ mkUnqual varName (fsLit "-") }
3245
3246 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
3247         : VARSYM               { sL1 $1 $ mkUnqual varName (getVARSYM $1) }
3248         | special_sym          { sL1 $1 $ mkUnqual varName (unLoc $1) }
3249
3250
3251 -- These special_ids are treated as keywords in various places,
3252 -- but as ordinary ids elsewhere.   'special_id' collects all these
3253 -- except 'unsafe', 'interruptible', 'forall', 'family', 'role', 'stock', and
3254 -- 'anyclass', whose treatment differs depending on context
3255 special_id :: { Located FastString }
3256 special_id
3257         : 'as'                  { sL1 $1 (fsLit "as") }
3258         | 'qualified'           { sL1 $1 (fsLit "qualified") }
3259         | 'hiding'              { sL1 $1 (fsLit "hiding") }
3260         | 'export'              { sL1 $1 (fsLit "export") }
3261         | 'label'               { sL1 $1 (fsLit "label")  }
3262         | 'dynamic'             { sL1 $1 (fsLit "dynamic") }
3263         | 'stdcall'             { sL1 $1 (fsLit "stdcall") }
3264         | 'ccall'               { sL1 $1 (fsLit "ccall") }
3265         | 'capi'                { sL1 $1 (fsLit "capi") }
3266         | 'prim'                { sL1 $1 (fsLit "prim") }
3267         | 'javascript'          { sL1 $1 (fsLit "javascript") }
3268         | 'group'               { sL1 $1 (fsLit "group") }
3269         | 'stock'               { sL1 $1 (fsLit "stock") }
3270         | 'anyclass'            { sL1 $1 (fsLit "anyclass") }