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