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