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