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