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