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