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