Parser: allow empty multi-line deprecation warnings
[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     | {- empty -}           { noLoc nilOL }
1426
1427 -----------------------------------------------------------------------------
1428 -- Annotations
1429 annotation :: { LHsDecl RdrName }
1430     : '{-# ANN' name_var aexp '#-}'      {% ams (sLL $1 $> (AnnD $ HsAnnotation
1431                                             (getANN_PRAGs $1)
1432                                             (ValueAnnProvenance $2) $3))
1433                                             [mo $1,mc $4] }
1434
1435     | '{-# ANN' 'type' tycon aexp '#-}'  {% ams (sLL $1 $> (AnnD $ HsAnnotation
1436                                             (getANN_PRAGs $1)
1437                                             (TypeAnnProvenance $3) $4))
1438                                             [mo $1,mj AnnType $2,mc $5] }
1439
1440     | '{-# ANN' 'module' aexp '#-}'      {% ams (sLL $1 $> (AnnD $ HsAnnotation
1441                                                 (getANN_PRAGs $1)
1442                                                  ModuleAnnProvenance $3))
1443                                                 [mo $1,mj AnnModule $2,mc $4] }
1444
1445
1446 -----------------------------------------------------------------------------
1447 -- Foreign import and export declarations
1448
1449 fdecl :: { Located ([AddAnn],HsDecl RdrName) }
1450 fdecl : 'import' callconv safety fspec
1451                {% mkImport $2 $3 (snd $ unLoc $4) >>= \i ->
1452                  return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i))  }
1453       | 'import' callconv        fspec
1454                {% do { d <- mkImport $2 (noLoc PlaySafe) (snd $ unLoc $3);
1455                     return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $3),d)) }}
1456       | 'export' callconv fspec
1457                {% mkExport $2 (snd $ unLoc $3) >>= \i ->
1458                   return (sLL $1 $> (mj AnnExport $1 : (fst $ unLoc $3),i) ) }
1459
1460 callconv :: { Located CCallConv }
1461           : 'stdcall'                   { sLL $1 $> StdCallConv }
1462           | 'ccall'                     { sLL $1 $> CCallConv   }
1463           | 'capi'                      { sLL $1 $> CApiConv    }
1464           | 'prim'                      { sLL $1 $> PrimCallConv}
1465           | 'javascript'                { sLL $1 $> JavaScriptCallConv }
1466
1467 safety :: { Located Safety }
1468         : 'unsafe'                      { sLL $1 $> PlayRisky }
1469         | 'safe'                        { sLL $1 $> PlaySafe }
1470         | 'interruptible'               { sLL $1 $> PlayInterruptible }
1471
1472 fspec :: { Located ([AddAnn]
1473                     ,(Located StringLiteral, Located RdrName, LHsType RdrName)) }
1474        : STRING var '::' sigtypedoc     { sLL $1 $> ([mj AnnDcolon $3]
1475                                              ,(L (getLoc $1)
1476                                                     (getStringLiteral $1), $2, $4)) }
1477        |        var '::' sigtypedoc     { sLL $1 $> ([mj AnnDcolon $2]
1478                                              ,(noLoc (StringLiteral "" nilFS), $1, $3)) }
1479          -- if the entity string is missing, it defaults to the empty string;
1480          -- the meaning of an empty entity string depends on the calling
1481          -- convention
1482
1483 -----------------------------------------------------------------------------
1484 -- Type signatures
1485
1486 opt_sig :: { ([AddAnn],Maybe (LHsType RdrName)) }
1487         : {- empty -}                   { ([],Nothing) }
1488         | '::' sigtype                  { ([mj AnnDcolon $1],Just $2) }
1489
1490 opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) }
1491         : {- empty -}                   { ([],Nothing) }
1492         | '::' atype                    { ([mj AnnDcolon $1],Just $2) }
1493
1494 sigtype :: { LHsType RdrName }          -- Always a HsForAllTy,
1495                                         -- to tell the renamer where to generalise
1496         : ctype                         { sL1 $1 (mkImplicitHsForAllTy $1) }
1497         -- Wrap an Implicit forall if there isn't one there already
1498
1499 sigtypedoc :: { LHsType RdrName }       -- Always a HsForAllTy
1500         : ctypedoc                      { sL1 $1 (mkImplicitHsForAllTy $1) }
1501         -- Wrap an Implicit forall if there isn't one there already
1502
1503 sig_vars :: { Located [Located RdrName] }    -- Returned in reversed order
1504          : sig_vars ',' var           {% addAnnotation (gl $ head $ unLoc $1)
1505                                                        AnnComma (gl $2)
1506                                          >> return (sLL $1 $> ($3 : unLoc $1)) }
1507          | var                        { sL1 $1 [$1] }
1508
1509 sigtypes1 :: { (OrdList (LHsType RdrName)) }      -- Always HsForAllTys
1510         : sigtype                      { unitOL $1 }
1511         | sigtype ',' sigtypes1        {% addAnnotation (gl $1) AnnComma (gl $2)
1512                                           >> return ((unitOL $1) `appOL` $3) }
1513
1514 -----------------------------------------------------------------------------
1515 -- Types
1516
1517 strict_mark :: { Located ([AddAnn],HsSrcBang) }
1518         : strictness { sL1 $1 (let (a, str) = unLoc $1 in (a, HsSrcBang Nothing NoSrcUnpack str)) }
1519         | unpackedness { sL1 $1 (let (a, prag, unpk) = unLoc $1 in (a, HsSrcBang prag unpk NoSrcStrict)) }
1520         | unpackedness strictness { sLL $1 $> (let { (a, prag, unpk) = unLoc $1
1521                                                    ; (a', str) = unLoc $2 }
1522                                                 in (a ++ a', HsSrcBang prag unpk str)) }
1523         -- Although UNPACK with no '!' without StrictData and UNPACK with '~' are illegal,
1524         -- we get a better error message if we parse them here
1525
1526 strictness :: { Located ([AddAnn], SrcStrictness) }
1527         : '!' { sL1 $1 ([mj AnnBang $1], SrcStrict) }
1528         | '~' { sL1 $1 ([mj AnnTilde $1], SrcLazy) }
1529
1530 unpackedness :: { Located ([AddAnn], Maybe SourceText, SrcUnpackedness) }
1531         : '{-# UNPACK' '#-}'   { sLL $1 $> ([mo $1, mc $2], Just $ getUNPACK_PRAGs $1, SrcUnpack) }
1532         | '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], Just $ getNOUNPACK_PRAGs $1, SrcNoUnpack) }
1533
1534 -- A ctype is a for-all type
1535 ctype   :: { LHsType RdrName }
1536         : 'forall' tv_bndrs '.' ctype   {% hintExplicitForall (getLoc $1) >>
1537                                            ams (sLL $1 $> $ mkExplicitHsForAllTy $2
1538                                                                  (noLoc []) $4)
1539                                                [mj AnnForall $1,mj AnnDot $3] }
1540         | context '=>' ctype          {% addAnnotation (gl $1) AnnDarrow (gl $2)
1541                                          >> return (sLL $1 $> $
1542                                                mkQualifiedHsForAllTy $1 $3) }
1543         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
1544                                              [mj AnnVal $1,mj AnnDcolon $2] }
1545         | type                        { $1 }
1546
1547 ----------------------
1548 -- Notes for 'ctypedoc'
1549 -- It would have been nice to simplify the grammar by unifying `ctype` and
1550 -- ctypedoc` into one production, allowing comments on types everywhere (and
1551 -- rejecting them after parsing, where necessary).  This is however not possible
1552 -- since it leads to ambiguity. The reason is the support for comments on record
1553 -- fields:
1554 --         data R = R { field :: Int -- ^ comment on the field }
1555 -- If we allow comments on types here, it's not clear if the comment applies
1556 -- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
1557
1558 ctypedoc :: { LHsType RdrName }
1559         : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
1560                                             ams (sLL $1 $> $ mkExplicitHsForAllTy $2
1561                                                                   (noLoc []) $4)
1562                                                 [mj AnnForall $1,mj AnnDot $3] }
1563         | context '=>' ctypedoc       {% addAnnotation (gl $1) AnnDarrow (gl $2)
1564                                          >> return (sLL $1 $> $
1565                                                   mkQualifiedHsForAllTy $1 $3) }
1566         | ipvar '::' type             {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
1567                                              [mj AnnVal $1,mj AnnDcolon $2] }
1568         | typedoc                     { $1 }
1569
1570 ----------------------
1571 -- Notes for 'context'
1572 -- We parse a context as a btype so that we don't get reduce/reduce
1573 -- errors in ctype.  The basic problem is that
1574 --      (Eq a, Ord a)
1575 -- looks so much like a tuple type.  We can't tell until we find the =>
1576
1577 -- We have the t1 ~ t2 form both in 'context' and in type,
1578 -- to permit an individual equational constraint without parenthesis.
1579 -- Thus for some reason we allow    f :: a~b => blah
1580 -- but not                          f :: ?x::Int => blah
1581 -- See Note [Parsing ~]
1582 context :: { LHsContext RdrName }
1583         :  btype                        {% do { (anns,ctx) <- checkContext (splitTilde $1)
1584                                                 ; if null (unLoc ctx)
1585                                                    then addAnnotation (gl $1) AnnUnit (gl $1)
1586                                                    else return ()
1587                                                 ; ams ctx anns
1588                                                 } }
1589 -- See Note [Parsing ~]
1590 type :: { LHsType RdrName }
1591         : btype                         { splitTilde $1 }
1592         | btype qtyconop type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1593         | btype tyvarop  type           { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1594         | btype '->'     ctype          {% ams $1 [mj AnnRarrow $2]
1595                                         >> ams (sLL $1 $> $ HsFunTy (splitTilde $1) $3)
1596                                                [mj AnnRarrow $2] }
1597         | btype SIMPLEQUOTE qconop type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1598                                                 [mj AnnSimpleQuote $2] }
1599         | btype SIMPLEQUOTE varop  type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1600                                                 [mj AnnSimpleQuote $2] }
1601 -- See Note [Parsing ~]
1602 typedoc :: { LHsType RdrName }
1603         : btype                          { splitTilde $1 }
1604         | btype docprev                  { sLL $1 $> $ HsDocTy (splitTilde $1) $2 }
1605         | btype qtyconop type            { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1606         | btype qtyconop type docprev    { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
1607         | btype tyvarop  type            { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
1608         | btype tyvarop  type docprev    { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
1609         | btype '->'     ctypedoc        {% ams (sLL $1 $> $ HsFunTy (splitTilde $1) $3)
1610                                                 [mj AnnRarrow $2] }
1611         | btype docprev '->' ctypedoc    {% ams (sLL $1 $> $ HsFunTy (L (comb2 (splitTilde $1) $2)
1612                                                             (HsDocTy $1 $2)) $4)
1613                                                 [mj AnnRarrow $3] }
1614         | btype SIMPLEQUOTE qconop type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1615                                                 [mj AnnSimpleQuote $2] }
1616         | btype SIMPLEQUOTE varop  type  {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
1617                                                 [mj AnnSimpleQuote $2] }
1618
1619 btype :: { LHsType RdrName }
1620         : btype atype                   { sLL $1 $> $ HsAppTy $1 $2 }
1621         | atype                         { $1 }
1622
1623 atype :: { LHsType RdrName }
1624         : ntgtycon                       { sL1 $1 (HsTyVar (unLoc $1)) }      -- Not including unit tuples
1625         | tyvar                          {% do { nwc <- namedWildCardsEnabled -- (See Note [Unit tuples])
1626                                                ; let tv@(Unqual name) = unLoc $1
1627                                                ; return $ if (startsWithUnderscore name && nwc)
1628                                                           then (sL1 $1 (mkNamedWildCardTy tv))
1629                                                           else (sL1 $1 (HsTyVar tv)) } }
1630
1631         | strict_mark atype              {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2))
1632                                                 (fst $ unLoc $1) }  -- Constructor sigs only
1633         | '{' fielddecls '}'             {% amms (checkRecordSyntax
1634                                                     (sLL $1 $> $ HsRecTy $2))
1635                                                         -- Constructor sigs only
1636                                                  [moc $1,mcc $3] }
1637         | '(' ')'                        {% ams (sLL $1 $> $ HsTupleTy
1638                                                     HsBoxedOrConstraintTuple [])
1639                                                 [mop $1,mcp $2] }
1640         | '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
1641                                                           (gl $3) >>
1642                                             ams (sLL $1 $> $ HsTupleTy
1643                                              HsBoxedOrConstraintTuple ($2 : $4))
1644                                                 [mop $1,mcp $5] }
1645         | '(#' '#)'                   {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple [])
1646                                              [mo $1,mc $2] }
1647         | '(#' comma_types1 '#)'      {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple $2)
1648                                              [mo $1,mc $3] }
1649         | '[' ctype ']'               {% ams (sLL $1 $> $ HsListTy  $2) [mos $1,mcs $3] }
1650         | '[:' ctype ':]'             {% ams (sLL $1 $> $ HsPArrTy  $2) [mo $1,mc $3] }
1651         | '(' ctype ')'               {% ams (sLL $1 $> $ HsParTy   $2) [mop $1,mcp $3] }
1652         | '(' ctype '::' kind ')'     {% ams (sLL $1 $> $ HsKindSig $2 $4)
1653                                              [mop $1,mj AnnDcolon $3,mcp $5] }
1654         | quasiquote                  { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
1655         | '$(' exp ')'                {% ams (sLL $1 $> $ mkHsSpliceTy $2)
1656                                              [mj AnnOpenPE $1,mj AnnCloseP $3] }
1657         | TH_ID_SPLICE                {%ams (sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $
1658                                              mkUnqual varName (getTH_ID_SPLICE $1))
1659                                              [mj AnnThIdSplice $1] }
1660                                       -- see Note [Promotion] for the followings
1661         | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar $ unLoc $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
1662         | SIMPLEQUOTE  '(' ctype ',' comma_types1 ')'
1663                              {% addAnnotation (gl $3) AnnComma (gl $4) >>
1664                                 ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5))
1665                                     [mj AnnSimpleQuote $1,mop $2,mcp $6] }
1666         | SIMPLEQUOTE  '[' comma_types0 ']'     {% ams (sLL $1 $> $ HsExplicitListTy
1667                                                             placeHolderKind $3)
1668                                                        [mj AnnSimpleQuote $1,mos $2,mcs $4] }
1669         | SIMPLEQUOTE var                       {% ams (sLL $1 $> $ HsTyVar $ unLoc $2)
1670                                                        [mj AnnSimpleQuote $1,mj AnnName $2] }
1671
1672         -- Two or more [ty, ty, ty] must be a promoted list type, just as
1673         -- if you had written '[ty, ty, ty]
1674         -- (One means a list type, zero means the list type constructor,
1675         -- so you have to quote those.)
1676         | '[' ctype ',' comma_types1 ']'  {% addAnnotation (gl $2) AnnComma
1677                                                            (gl $3) >>
1678                                              ams (sLL $1 $> $ HsExplicitListTy
1679                                                      placeHolderKind ($2 : $4))
1680                                                  [mos $1,mcs $5] }
1681         | INTEGER              { sLL $1 $> $ HsTyLit $ HsNumTy (getINTEGERs $1)
1682                                                                (getINTEGER $1) }
1683         | STRING               { sLL $1 $> $ HsTyLit $ HsStrTy (getSTRINGs $1)
1684                                                                (getSTRING  $1) }
1685         | '_'                  { sL1 $1 $ mkAnonWildCardTy }
1686
1687 -- An inst_type is what occurs in the head of an instance decl
1688 --      e.g.  (Foo a, Gaz b) => Wibble a b
1689 -- It's kept as a single type, with a MonoDictTy at the right
1690 -- hand corner, for convenience.
1691 inst_type :: { LHsType RdrName }
1692         : sigtype                       { $1 }
1693
1694 inst_types1 :: { [LHsType RdrName] }
1695         : inst_type                     { [$1] }
1696
1697         | inst_type ',' inst_types1    {% addAnnotation (gl $1) AnnComma (gl $2)
1698                                           >> return ($1 : $3) }
1699
1700 comma_types0  :: { [LHsType RdrName] }  -- Zero or more:  ty,ty,ty
1701         : comma_types1                  { $1 }
1702         | {- empty -}                   { [] }
1703
1704 comma_types1    :: { [LHsType RdrName] }  -- One or more:  ty,ty,ty
1705         : ctype                        { [$1] }
1706         | ctype  ',' comma_types1      {% addAnnotation (gl $1) AnnComma (gl $2)
1707                                           >> return ($1 : $3) }
1708
1709 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1710          : tv_bndr tv_bndrs             { $1 : $2 }
1711          | {- empty -}                  { [] }
1712
1713 tv_bndr :: { LHsTyVarBndr RdrName }
1714         : tyvar                         { sL1 $1 (UserTyVar (unLoc $1)) }
1715         | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar $2 $4))
1716                                                [mop $1,mj AnnDcolon $3
1717                                                ,mcp $5] }
1718
1719 fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
1720         : {- empty -}                   { noLoc ([],[]) }
1721         | '|' fds1                      { (sLL $1 $> ([mj AnnVbar $1]
1722                                                  ,reverse (unLoc $2))) }
1723
1724 fds1 :: { Located [Located (FunDep (Located RdrName))] }
1725         : fds1 ',' fd   {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2)
1726                            >> return (sLL $1 $> ($3 : unLoc $1)) }
1727         | fd            { sL1 $1 [$1] }
1728
1729 fd :: { Located (FunDep (Located RdrName)) }
1730         : varids0 '->' varids0  {% ams (L (comb3 $1 $2 $3)
1731                                        (reverse (unLoc $1), reverse (unLoc $3)))
1732                                        [mj AnnRarrow $2] }
1733
1734 varids0 :: { Located [Located RdrName] }
1735         : {- empty -}                   { noLoc [] }
1736         | varids0 tyvar                 { sLL $1 $> ($2 : unLoc $1) }
1737
1738 {-
1739 Note [Parsing ~]
1740 ~~~~~~~~~~~~~~~~
1741
1742 Due to parsing conflicts between lazyness annotations in data type
1743 declarations (see strict_mark) and equality types ~'s are always
1744 parsed as lazyness annotations, and turned into HsEqTy's in the
1745 correct places using RdrHsSyn.splitTilde.
1746
1747 Since strict_mark is parsed as part of atype which is part of type,
1748 typedoc and context (where HsEqTy previously appeared) it made most
1749 sense and was simplest to parse ~ as part of strict_mark and later
1750 turn them into HsEqTy's.
1751
1752 -}
1753
1754
1755 -----------------------------------------------------------------------------
1756 -- Kinds
1757
1758 kind :: { LHsKind RdrName }
1759         : bkind                  { $1 }
1760         | bkind '->' kind        {% ams (sLL $1 $> $ HsFunTy $1 $3)
1761                                         [mj AnnRarrow $2] }
1762
1763 bkind :: { LHsKind RdrName }
1764         : akind                  { $1 }
1765         | bkind akind            { sLL $1 $> $ HsAppTy $1 $2 }
1766
1767 akind :: { LHsKind RdrName }
1768         : '*'                    { sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName) }
1769         | '(' kind ')'           {% ams (sLL $1 $>  $ HsParTy $2)
1770                                         [mop $1,mcp $3] }
1771         | pkind                  { $1 }
1772         | tyvar                  { sL1 $1 $ HsTyVar (unLoc $1) }
1773
1774 pkind :: { LHsKind RdrName }  -- promoted type, see Note [Promotion]
1775         : qtycon                          { sL1 $1 $ HsTyVar $ unLoc $1 }
1776         | '(' ')'                   {% ams (sLL $1 $> $ HsTyVar $ getRdrName unitTyCon)
1777                                            [mop $1,mcp $2] }
1778         | '(' kind ',' comma_kinds1 ')'
1779                           {% addAnnotation (gl $2) AnnComma (gl $3) >>
1780                              ams (sLL $1 $> $ HsTupleTy HsBoxedTuple ( $2 : $4))
1781                                  [mop $1,mcp $5] }
1782         | '[' kind ']'                    {% ams (sLL $1 $> $ HsListTy $2)
1783                                                  [mos $1,mcs $3] }
1784
1785 comma_kinds1 :: { [LHsKind RdrName] }
1786         : kind                         { [$1] }
1787         | kind  ',' comma_kinds1       {% addAnnotation (gl $1) AnnComma (gl $2)
1788                                           >> return ($1 : $3) }
1789
1790 {- Note [Promotion]
1791    ~~~~~~~~~~~~~~~~
1792
1793 - Syntax of promoted qualified names
1794 We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
1795 names. Moreover ticks are only allowed in types, not in kinds, for a
1796 few reasons:
1797   1. we don't need quotes since we cannot define names in kinds
1798   2. if one day we merge types and kinds, tick would mean look in DataName
1799   3. we don't have a kind namespace anyway
1800
1801 - Syntax of explicit kind polymorphism  (IA0_TODO: not yet implemented)
1802 Kind abstraction is implicit. We write
1803 > data SList (s :: k -> *) (as :: [k]) where ...
1804 because it looks like what we do in terms
1805 > id (x :: a) = x
1806
1807 - Name resolution
1808 When the user write Zero instead of 'Zero in types, we parse it a
1809 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
1810 deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
1811 bounded in the type level, then we look for it in the term level (we
1812 change its namespace to DataName, see Note [Demotion] in OccName). And
1813 both become a HsTyVar ("Zero", DataName) after the renamer.
1814
1815 -}
1816
1817
1818 -----------------------------------------------------------------------------
1819 -- Datatype declarations
1820
1821 gadt_constrlist :: { Located ([AddAnn]
1822                           ,[LConDecl RdrName]) } -- Returned in order
1823         : 'where' '{'        gadt_constrs '}'   { L (comb2 $1 $3)
1824                                                     ([mj AnnWhere $1
1825                                                      ,moc $2
1826                                                      ,mcc $4]
1827                                                     , unLoc $3) }
1828         | 'where' vocurly    gadt_constrs close  { L (comb2 $1 $3)
1829                                                      ([mj AnnWhere $1]
1830                                                      , unLoc $3) }
1831         | {- empty -}                            { noLoc ([],[]) }
1832
1833 gadt_constrs :: { Located [LConDecl RdrName] }
1834         : gadt_constr_with_doc ';' gadt_constrs
1835                   {% addAnnotation (gl $1) AnnSemi (gl $2)
1836                      >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
1837         | gadt_constr_with_doc          { L (gl $1) [$1] }
1838         | {- empty -}                   { noLoc [] }
1839
1840 -- We allow the following forms:
1841 --      C :: Eq a => a -> T a
1842 --      C :: forall a. Eq a => !a -> T a
1843 --      D { x,y :: a } :: T a
1844 --      forall a. Eq a => D { x,y :: a } :: T a
1845
1846 gadt_constr_with_doc :: { LConDecl RdrName }
1847 gadt_constr_with_doc
1848         : maybe_docnext ';' gadt_constr
1849                 {% return $ addConDoc $3 $1 }
1850         | gadt_constr
1851                 {% return $1 }
1852
1853 gadt_constr :: { LConDecl RdrName }
1854     -- see Note [Difference in parsing GADT and data constructors]
1855     -- Returns a list because of:   C,D :: ty
1856         : con_list '::' sigtype
1857                 {% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3
1858                       ; ams (sLL $1 $> gadtDecl)
1859                             (mj AnnDcolon $2:anns) } }
1860
1861 {- Note [Difference in parsing GADT and data constructors]
1862 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1863 GADT constructors have simpler syntax than usual data constructors:
1864 in GADTs, types cannot occur to the left of '::', so they cannot be mixed
1865 with constructor names (see Note [Parsing data constructors is hard]).
1866
1867 Due to simplified syntax, GADT constructor names (left-hand side of '::')
1868 use simpler grammar production than usual data constructor names. As a
1869 consequence, GADT constructor names are resticted (names like '(*)' are
1870 allowed in usual data constructors, but not in GADTs).
1871 -}
1872
1873 constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
1874         : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
1875                                                      ,addConDocs (unLoc $3) $1)}
1876
1877 constrs1 :: { Located [LConDecl RdrName] }
1878         : constrs1 maybe_docnext '|' maybe_docprev constr
1879             {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
1880                >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
1881         | constr                                          { sL1 $1 [$1] }
1882
1883 constr :: { LConDecl RdrName }
1884         : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1885                 {% ams (let (con,details) = unLoc $5 in
1886                   addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con
1887                                                    (snd $ unLoc $2) $3 details))
1888                             ($1 `mplus` $6))
1889                         (mj AnnDarrow $4:(fst $ unLoc $2)) }
1890         | maybe_docnext forall constr_stuff maybe_docprev
1891                 {% ams ( let (con,details) = unLoc $3 in
1892                   addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con
1893                                            (snd $ unLoc $2) (noLoc []) details))
1894                             ($1 `mplus` $4))
1895                        (fst $ unLoc $2) }
1896
1897 forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) }
1898         : 'forall' tv_bndrs '.'       { sLL $1 $> ([mj AnnForall $1,mj AnnDot $3],$2) }
1899         | {- empty -}                 { noLoc ([],[]) }
1900
1901 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1902     -- see Note [Parsing data constructors is hard]
1903         : btype                         {% splitCon $1 >>= return.sLL $1 $> }
1904         | btype conop btype             {  sLL $1 $> ($2, InfixCon $1 $3) }
1905
1906 {- Note [Parsing data constructors is hard]
1907 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1908 We parse the constructor declaration
1909      C t1 t2
1910 as a btype (treating C as a type constructor) and then convert C to be
1911 a data constructor.  Reason: it might continue like this:
1912      C t1 t2 %: D Int
1913 in which case C really would be a type constructor.  We can't resolve this
1914 ambiguity till we come across the constructor oprerator :% (or not, more usually)
1915 -}
1916
1917 fielddecls :: { [LConDeclField RdrName] }
1918         : {- empty -}     { [] }
1919         | fielddecls1     { $1 }
1920
1921 fielddecls1 :: { [LConDeclField RdrName] }
1922         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
1923             {% addAnnotation (gl $1) AnnComma (gl $3) >>
1924                return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
1925         | fielddecl   { [$1] }
1926
1927 fielddecl :: { LConDeclField RdrName }
1928                                               -- A list because of   f,g :: Int
1929         : maybe_docnext sig_vars '::' ctype maybe_docprev
1930             {% ams (L (comb2 $2 $4)
1931                       (ConDeclField (reverse (map (fmap (flip FieldOcc PlaceHolder)) (unLoc $2))) $4 ($1 `mplus` $5)))
1932                    [mj AnnDcolon $3] }
1933
1934 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1935 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1936 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1937 -- We don't allow a context, but that's sorted out by the type checker.
1938 deriving :: { Located (Maybe (Located [LHsType RdrName])) }
1939         : {- empty -}             { noLoc Nothing }
1940         | 'deriving' qtycon       {% aljs ( let { L loc tv = $2 }
1941                                             in (sLL $1 $> (Just (sLL $1 $>
1942                                                        [L loc (HsTyVar tv)]))))
1943                                           [mj AnnDeriving $1] }
1944         | 'deriving' '(' ')'      {% aljs (sLL $1 $> (Just (sLL $1 $> [])))
1945                                           [mj AnnDeriving $1,mop $2,mcp $3] }
1946
1947         | 'deriving' '(' inst_types1 ')'  {% aljs (sLL $1 $> (Just (sLL $1 $> $3)))
1948                                                  [mj AnnDeriving $1,mop $2,mcp $4] }
1949              -- Glasgow extension: allow partial
1950              -- applications in derivings
1951
1952 -----------------------------------------------------------------------------
1953 -- Value definitions
1954
1955 {- Note [Declaration/signature overlap]
1956 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1957 There's an awkward overlap with a type signature.  Consider
1958         f :: Int -> Int = ...rhs...
1959    Then we can't tell whether it's a type signature or a value
1960    definition with a result signature until we see the '='.
1961    So we have to inline enough to postpone reductions until we know.
1962 -}
1963
1964 {-
1965   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1966   instead of qvar, we get another shift/reduce-conflict. Consider the
1967   following programs:
1968
1969      { (^^) :: Int->Int ; }          Type signature; only var allowed
1970
1971      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
1972                                      qvar allowed (because of instance decls)
1973
1974   We can't tell whether to reduce var to qvar until after we've read the signatures.
1975 -}
1976
1977 docdecl :: { LHsDecl RdrName }
1978         : docdecld { sL1 $1 (DocD (unLoc $1)) }
1979
1980 docdecld :: { LDocDecl }
1981         : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
1982         | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
1983         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
1984         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
1985
1986 decl_no_th :: { LHsDecl RdrName }
1987         : sigdecl               { $1 }
1988
1989         | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) };
1990                                         pat <- checkPattern empty e;
1991                                         _ <- ams (sLL $1 $> ())
1992                                                (fst $ unLoc $3);
1993                                         return $ sLL $1 $> $ ValD $
1994                                             PatBind pat (snd $ unLoc $3)
1995                                                     placeHolderType
1996                                                     placeHolderNames
1997                                                     ([],[]) } }
1998                                 -- Turn it all into an expression so that
1999                                 -- checkPattern can check that bangs are enabled
2000
2001         | infixexp opt_sig rhs  {% do { (ann,r) <- checkValDef empty $1 (snd $2) $3;
2002                                         let { l = comb2 $1 $> };
2003                                         case r of {
2004                                           (FunBind n _ _ _ _ _) ->
2005                                                 ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
2006                                           (PatBind (L lh _lhs) _rhs _ _ _) ->
2007                                                 ams (L lh ()) (fst $2) >> return () } ;
2008                                         _ <- ams (L l ()) (ann ++ (fst $ unLoc $3));
2009                                         return $! (sL l $ ValD r) } }
2010         | pattern_synonym_decl  { $1 }
2011         | docdecl               { $1 }
2012
2013 decl    :: { LHsDecl RdrName }
2014         : decl_no_th            { $1 }
2015
2016         -- Why do we only allow naked declaration splices in top-level
2017         -- declarations and not here? Short answer: because readFail009
2018         -- fails terribly with a panic in cvBindsAndSigs otherwise.
2019         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
2020
2021 rhs     :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2022         : '=' exp wherebinds    { sL (comb3 $1 $2 $3)
2023                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
2024                                     ,GRHSs (unguardedRHS (comb3 $1 $2 $3) $2)
2025                                    (snd $ unLoc $3)) }
2026         | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
2027                                     ,GRHSs (reverse (unLoc $1))
2028                                                     (snd $ unLoc $2)) }
2029
2030 gdrhs :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2031         : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
2032         | gdrh                  { sL1 $1 [$1] }
2033
2034 gdrh :: { LGRHS RdrName (LHsExpr RdrName) }
2035         : '|' guardquals '=' exp  {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2036                                          [mj AnnVbar $1,mj AnnEqual $3] }
2037
2038 sigdecl :: { LHsDecl RdrName }
2039         :
2040         -- See Note [Declaration/signature overlap] for why we need infixexp here
2041           infixexp '::' sigtypedoc
2042                         {% do s <- checkValSig $1 $3
2043                         ; _ <- ams (sLL $1 $> ()) [mj AnnDcolon $2]
2044                         ; return (sLL $1 $> $ SigD s) }
2045
2046         | var ',' sig_vars '::' sigtypedoc
2047            {% do { let sig = TypeSig ($1 : reverse (unLoc $3)) $5 PlaceHolder
2048                  ; addAnnotation (gl $1) AnnComma (gl $2)
2049                  ; ams ( sLL $1 $> $ SigD sig )
2050                        [mj AnnDcolon $4] } }
2051
2052         | infix prec ops
2053               {% ams (sLL $1 $> $ SigD
2054                         (FixSig (FixitySig (fromOL $ unLoc $3)
2055                                 (Fixity (unLoc $2) (unLoc $1)))))
2056                      [mj AnnInfix $1,mj AnnVal $2] }
2057
2058         | pattern_synonym_sig   { sLL $1 $> . SigD . unLoc $ $1 }
2059
2060         | '{-# INLINE' activation qvar '#-}'
2061                 {% ams ((sLL $1 $> $ SigD (InlineSig $3
2062                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
2063                                             (snd $2)))))
2064                        ((mo $1:fst $2) ++ [mc $4]) }
2065
2066         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
2067              {% ams (
2068                  let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
2069                                              (EmptyInlineSpec, FunLike) (snd $2)
2070                   in sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag))
2071                     (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
2072
2073         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
2074              {% ams (sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
2075                                (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
2076                                                (getSPEC_INLINE $1) (snd $2))))
2077                        (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
2078
2079         | '{-# SPECIALISE' 'instance' inst_type '#-}'
2080                 {% ams (sLL $1 $>
2081                                   $ SigD (SpecInstSig (getSPEC_PRAGs $1) $3))
2082                        [mo $1,mj AnnInstance $2,mc $4] }
2083
2084         -- A minimal complete definition
2085         | '{-# MINIMAL' name_boolformula_opt '#-}'
2086             {% ams (sLL $1 $> $ SigD (MinimalSig (getMINIMAL_PRAGs $1) $2))
2087                    [mo $1,mc $3] }
2088
2089 activation :: { ([AddAnn],Maybe Activation) }
2090         : {- empty -}                           { ([],Nothing) }
2091         | explicit_activation                   { (fst $1,Just (snd $1)) }
2092
2093 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
2094         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
2095                                   ,ActiveAfter  (fromInteger (getINTEGER $2))) }
2096         | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
2097                                                  ,mj AnnCloseS $4]
2098                                   ,ActiveBefore (fromInteger (getINTEGER $3))) }
2099
2100 -----------------------------------------------------------------------------
2101 -- Expressions
2102
2103 quasiquote :: { Located (HsSplice RdrName) }
2104         : TH_QUASIQUOTE   { let { loc = getLoc $1
2105                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
2106                                 ; quoterId = mkUnqual varName quoter }
2107                             in sL1 $1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2108         | TH_QQUASIQUOTE  { let { loc = getLoc $1
2109                                 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
2110                                 ; quoterId = mkQual varName (qual, quoter) }
2111                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2112
2113 exp   :: { LHsExpr RdrName }
2114         : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 $3 PlaceHolder)
2115                                        [mj AnnDcolon $2] }
2116         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2117                                                         HsFirstOrderApp True)
2118                                        [mj Annlarrowtail $2] }
2119         | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2120                                                       HsFirstOrderApp False)
2121                                        [mj Annrarrowtail $2] }
2122         | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2123                                                       HsHigherOrderApp True)
2124                                        [mj AnnLarrowtail $2] }
2125         | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2126                                                       HsHigherOrderApp False)
2127                                        [mj AnnRarrowtail $2] }
2128         | infixexp              { $1 }
2129
2130 infixexp :: { LHsExpr RdrName }
2131         : exp10                   { $1 }
2132         | infixexp qop exp10      {% ams (sLL $1 $>
2133                                              (OpApp $1 $2 placeHolderFixity $3))
2134                                          [mj AnnVal $2] }
2135                  -- AnnVal annotation for NPlusKPat, which discards the operator
2136
2137
2138 exp10 :: { LHsExpr RdrName }
2139         : '\\' apat apats opt_asig '->' exp
2140                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
2141                             [sLL $1 $> $ Match Nothing ($2:$3) (snd $4) (unguardedGRHSs $6)]))
2142                           (mj AnnLam $1:mj AnnRarrow $5:(fst $4)) }
2143         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
2144                                                (mj AnnLet $1:mj AnnIn $3
2145                                                  :(fst $ unLoc $2)) }
2146         | '\\' 'lcase' altslist
2147             {% ams (sLL $1 $> $ HsLamCase placeHolderType
2148                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
2149                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
2150         | 'if' exp optSemi 'then' exp optSemi 'else' exp
2151                            {% checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
2152                               ams (sLL $1 $> $ mkHsIf $2 $5 $8)
2153                                   (mj AnnIf $1:mj AnnThen $4
2154                                      :mj AnnElse $7
2155                                      :(map (\l -> mj AnnSemi l) (fst $3))
2156                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
2157         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
2158                                            ams (sLL $1 $> $ HsMultiIf
2159                                                      placeHolderType
2160                                                      (reverse $ snd $ unLoc $2))
2161                                                (mj AnnIf $1:(fst $ unLoc $2)) }
2162         | 'case' exp 'of' altslist      {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
2163                                                    FromSource (snd $ unLoc $4)))
2164                                                (mj AnnCase $1:mj AnnOf $3
2165                                                   :(fst $ unLoc $4)) }
2166         | '-' fexp                      {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
2167                                                [mj AnnMinus $1] }
2168
2169         | 'do' stmtlist              {% ams (L (comb2 $1 $2)
2170                                                (mkHsDo DoExpr (snd $ unLoc $2)))
2171                                                (mj AnnDo $1:(fst $ unLoc $2)) }
2172         | 'mdo' stmtlist            {% ams (L (comb2 $1 $2)
2173                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
2174                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
2175
2176         | scc_annot exp        {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2177                                       (fst $ fst $ unLoc $1) }
2178
2179         | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2180                                       (fst $ fst $ unLoc $1) }
2181
2182         | 'proc' aexp '->' exp
2183                        {% checkPattern empty $2 >>= \ p ->
2184                            checkCommand $4 >>= \ cmd ->
2185                            ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
2186                                                 placeHolderType []))
2187                                             -- TODO: is LL right here?
2188                                [mj AnnProc $1,mj AnnRarrow $3] }
2189
2190         | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4)
2191                                               [mo $1,mj AnnVal $2
2192                                               ,mc $3] }
2193                                           -- hdaume: core annotation
2194         | fexp                         { $1 }
2195
2196 optSemi :: { ([Located a],Bool) }
2197         : ';'         { ([$1],True) }
2198         | {- empty -} { ([],False) }
2199
2200 scc_annot :: { Located (([AddAnn],SourceText),StringLiteral) }
2201         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
2202                                             ; return $ sLL $1 $>
2203                                                (([mo $1,mj AnnValStr $2
2204                                                 ,mc $3],getSCC_PRAGs $1),(StringLiteral (getSTRINGs $2) scc)) }
2205         | '{-# SCC' VARID  '#-}'      { sLL $1 $> (([mo $1,mj AnnVal $2
2206                                          ,mc $3],getSCC_PRAGs $1)
2207                                         ,(StringLiteral (unpackFS $ getVARID $2) (getVARID $2))) }
2208
2209 hpc_annot :: { Located (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))) }
2210       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
2211                                       { sLL $1 $> $ (([mo $1,mj AnnVal $2
2212                                               ,mj AnnVal $3,mj AnnColon $4
2213                                               ,mj AnnVal $5,mj AnnMinus $6
2214                                               ,mj AnnVal $7,mj AnnColon $8
2215                                               ,mj AnnVal $9,mc $10],
2216                                                 getGENERATED_PRAGs $1)
2217                                               ,((getStringLiteral $2)
2218                                                ,( fromInteger $ getINTEGER $3
2219                                                 , fromInteger $ getINTEGER $5
2220                                                 )
2221                                                ,( fromInteger $ getINTEGER $7
2222                                                 , fromInteger $ getINTEGER $9
2223                                                 )
2224                                                ))
2225                                          }
2226
2227 fexp    :: { LHsExpr RdrName }
2228         : fexp aexp                             { sLL $1 $> $ HsApp $1 $2 }
2229         | 'static' aexp                         {% ams (sLL $1 $> $ HsStatic $2)
2230                                                        [mj AnnStatic $1] }
2231         | aexp                                  { $1 }
2232
2233 aexp    :: { LHsExpr RdrName }
2234         : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
2235         | '~' aexp              {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
2236         | aexp1                 { $1 }
2237
2238 aexp1   :: { LHsExpr RdrName }
2239         : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
2240                                                                    (snd $3)
2241                                      ; _ <- ams (sLL $1 $> ()) (moc $2:mcc $4:(fst $3))
2242                                      ; checkRecordSyntax (sLL $1 $> r) }}
2243         | aexp2                { $1 }
2244
2245 aexp2   :: { LHsExpr RdrName }
2246         : qvar                          { sL1 $1 (HsVar   $! unLoc $1) }
2247         | qcon                          { sL1 $1 (HsVar   $! unLoc $1) }
2248         | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
2249         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
2250 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
2251 -- into HsOverLit when -foverloaded-strings is on.
2252 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
2253 --                                       (getSTRING $1) placeHolderType) }
2254         | INTEGER   { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGERs $1)
2255                                          (getINTEGER $1) placeHolderType) }
2256         | RATIONAL  { sL (getLoc $1) (HsOverLit $! mkHsFractional
2257                                           (getRATIONAL $1) placeHolderType) }
2258
2259         -- N.B.: sections get parsed by these next two productions.
2260         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
2261         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
2262         -- but the less cluttered version fell out of having texps.
2263         | '(' texp ')'                  {% ams (sLL $1 $> (HsPar $2)) [mop $1,mcp $3] }
2264         | '(' tup_exprs ')'             {% ams (sLL $1 $> (ExplicitTuple $2 Boxed))
2265                                                [mop $1,mcp $3] }
2266
2267         | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple [L (gl $2)
2268                                                          (Present $2)] Unboxed))
2269                                                [mo $1,mc $3] }
2270         | '(#' tup_exprs '#)'           {% ams (sLL $1 $> (ExplicitTuple $2 Unboxed))
2271                                                [mo $1,mc $3] }
2272
2273         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
2274         | '[:' parr ':]'    {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
2275         | '_'               { sL1 $1 EWildPat }
2276
2277         -- Template Haskell Extension
2278         | splice_exp            { $1 }
2279
2280         | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2281         | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2282         | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2283         | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2284         | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] }
2285         | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]}
2286         | '[t|' ctype '|]'    {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
2287         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
2288                                       ams (sLL $1 $> $ HsBracket (PatBr p))
2289                                           [mo $1,mc $3] }
2290         | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
2291                                       (mo $1:mc $3:fst $2) }
2292         | quasiquote          { sL1 $1 (HsSpliceE (unLoc $1)) }
2293
2294         -- arrow notation extension
2295         | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm $2
2296                                                            Nothing (reverse $3))
2297                                           [mo $1,mc $4] }
2298
2299 splice_exp :: { LHsExpr RdrName }
2300         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkHsSpliceE
2301                                         (sL1 $1 $ HsVar (mkUnqual varName
2302                                                         (getTH_ID_SPLICE $1))))
2303                                        [mj AnnThIdSplice $1] }
2304         | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE $2)
2305                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
2306         | TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkHsSpliceTE
2307                                         (sL1 $1 $ HsVar (mkUnqual varName
2308                                                      (getTH_ID_TY_SPLICE $1))))
2309                                        [mj AnnThIdTySplice $1] }
2310         | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE $2)
2311                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
2312
2313 cmdargs :: { [LHsCmdTop RdrName] }
2314         : cmdargs acmd                  { $2 : $1 }
2315         | {- empty -}                   { [] }
2316
2317 acmd    :: { LHsCmdTop RdrName }
2318         : aexp2                 {% checkCommand $1 >>= \ cmd ->
2319                                     return (sL1 $1 $ HsCmdTop cmd
2320                                            placeHolderType placeHolderType []) }
2321
2322 cvtopbody :: { ([AddAnn],[LHsDecl RdrName]) }
2323         :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1
2324                                                   ,mj AnnCloseC $3],$2) }
2325         |      vocurly    cvtopdecls0 close    { ([],$2) }
2326
2327 cvtopdecls0 :: { [LHsDecl RdrName] }
2328         : {- empty -}           { [] }
2329         | cvtopdecls            { $1 }
2330
2331 -----------------------------------------------------------------------------
2332 -- Tuple expressions
2333
2334 -- "texp" is short for tuple expressions:
2335 -- things that can appear unparenthesized as long as they're
2336 -- inside parens or delimitted by commas
2337 texp :: { LHsExpr RdrName }
2338         : exp                           { $1 }
2339
2340         -- Note [Parsing sections]
2341         -- ~~~~~~~~~~~~~~~~~~~~~~~
2342         -- We include left and right sections here, which isn't
2343         -- technically right according to the Haskell standard.
2344         -- For example (3 +, True) isn't legal.
2345         -- However, we want to parse bang patterns like
2346         --      (!x, !y)
2347         -- and it's convenient to do so here as a section
2348         -- Then when converting expr to pattern we unravel it again
2349         -- Meanwhile, the renamer checks that real sections appear
2350         -- inside parens.
2351         | infixexp qop        { sLL $1 $> $ SectionL $1 $2 }
2352         | qopm infixexp       { sLL $1 $> $ SectionR $1 $2 }
2353
2354        -- View patterns get parenthesized above
2355         | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] }
2356
2357 -- Always at least one comma
2358 tup_exprs :: { [LHsTupArg RdrName] }
2359            : texp commas_tup_tail
2360                           {% do { addAnnotation (gl $1) AnnComma (fst $2)
2361                                 ; return ((sL1 $1 (Present $1)) : snd $2) } }
2362
2363            | commas tup_tail
2364                 {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
2365                       ; return
2366                            (map (\l -> L l missingTupArg) (fst $1) ++ $2) } }
2367
2368 -- Always starts with commas; always follows an expr
2369 commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) }
2370 commas_tup_tail : commas tup_tail
2371        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
2372              ; return (
2373             (head $ fst $1
2374             ,(map (\l -> L l missingTupArg) (tail $ fst $1)) ++ $2)) } }
2375
2376 -- Always follows a comma
2377 tup_tail :: { [LHsTupArg RdrName] }
2378           : texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
2379                                     return ((L (gl $1) (Present $1)) : snd $2) }
2380           | texp                 { [L (gl $1) (Present $1)] }
2381           | {- empty -}          { [noLoc missingTupArg] }
2382
2383 -----------------------------------------------------------------------------
2384 -- List expressions
2385
2386 -- The rules below are little bit contorted to keep lexps left-recursive while
2387 -- avoiding another shift/reduce-conflict.
2388 list :: { ([AddAnn],HsExpr RdrName) }
2389         : texp    { ([],ExplicitList placeHolderType Nothing [$1]) }
2390         | lexps   { ([],ExplicitList placeHolderType Nothing
2391                                                    (reverse (unLoc $1))) }
2392         | texp '..'             { ([mj AnnDotdot $2],
2393                                       ArithSeq noPostTcExpr Nothing (From $1)) }
2394         | texp ',' exp '..'     { ([mj AnnComma $2,mj AnnDotdot $4],
2395                                   ArithSeq noPostTcExpr Nothing
2396                                                              (FromThen $1 $3)) }
2397         | texp '..' exp         { ([mj AnnDotdot $2],
2398                                    ArithSeq noPostTcExpr Nothing
2399                                                                (FromTo $1 $3)) }
2400         | texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
2401                                     ArithSeq noPostTcExpr Nothing
2402                                                 (FromThenTo $1 $3 $5)) }
2403         | texp '|' flattenedpquals
2404              {% checkMonadComp >>= \ ctxt ->
2405                 return ([mj AnnVbar $2],
2406                         mkHsComp ctxt (unLoc $3) $1) }
2407
2408 lexps :: { Located [LHsExpr RdrName] }
2409         : lexps ',' texp          {% addAnnotation (gl $ head $ unLoc $1)
2410                                                             AnnComma (gl $2) >>
2411                                       return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
2412         | texp ',' texp            {% addAnnotation (gl $1) AnnComma (gl $2) >>
2413                                       return (sLL $1 $> [$3,$1]) }
2414
2415 -----------------------------------------------------------------------------
2416 -- List Comprehensions
2417
2418 flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2419     : pquals   { case (unLoc $1) of
2420                     [qs] -> sL1 $1 qs
2421                     -- We just had one thing in our "parallel" list so
2422                     -- we simply return that thing directly
2423
2424                     qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock qs [] noSyntaxExpr |
2425                                             qs <- qss]
2426                                             noSyntaxExpr noSyntaxExpr]
2427                     -- We actually found some actual parallel lists so
2428                     -- we wrap them into as a ParStmt
2429                 }
2430
2431 pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] }
2432     : squals '|' pquals
2433                      {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
2434                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
2435     | squals         { L (getLoc $1) [reverse (unLoc $1)] }
2436
2437 squals :: { Located [LStmt RdrName (LHsExpr RdrName)] }   -- In reverse order, because the last
2438                                         -- one can "grab" the earlier ones
2439     : squals ',' transformqual
2440              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2441                 ams (sLL $1 $> ()) (fst $ unLoc $3) >>
2442                 return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
2443     | squals ',' qual
2444              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2445                 return (sLL $1 $> ($3 : unLoc $1)) }
2446     | transformqual        {% ams $1 (fst $ unLoc $1) >>
2447                               return (sLL $1 $> [L (getLoc $1) ((snd $ unLoc $1) [])]) }
2448     | qual                                { sL1 $1 [$1] }
2449 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
2450 --  | '{|' pquals '|}'                       { sL1 $1 [$2] }
2451
2452 -- It is possible to enable bracketing (associating) qualifier lists
2453 -- by uncommenting the lines with {| |} above. Due to a lack of
2454 -- consensus on the syntax, this feature is not being used until we
2455 -- get user demand.
2456
2457 transformqual :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)] -> Stmt RdrName (LHsExpr RdrName)) }
2458                         -- Function is applied to a list of stmts *in order*
2459     : 'then' exp               { sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
2460     | 'then' exp 'by' exp      { sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],\ss -> (mkTransformByStmt ss $2 $4)) }
2461     | 'then' 'group' 'using' exp
2462              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3], \ss -> (mkGroupUsingStmt ss $4)) }
2463
2464     | 'then' 'group' 'by' exp 'using' exp
2465              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5], \ss -> (mkGroupByUsingStmt ss $4 $6)) }
2466
2467 -- Note that 'group' is a special_id, which means that you can enable
2468 -- TransformListComp while still using Data.List.group. However, this
2469 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
2470 -- in by choosing the "group by" variant, which is what we want.
2471
2472 -----------------------------------------------------------------------------
2473 -- Parallel array expressions
2474
2475 -- The rules below are little bit contorted; see the list case for details.
2476 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
2477 -- Moreover, we allow explicit arrays with no element (represented by the nil
2478 -- constructor in the list case).
2479
2480 parr :: { ([AddAnn],HsExpr RdrName) }
2481         :                      { ([],ExplicitPArr placeHolderType []) }
2482         | texp                 { ([],ExplicitPArr placeHolderType [$1]) }
2483         | lexps                { ([],ExplicitPArr placeHolderType
2484                                                           (reverse (unLoc $1))) }
2485         | texp '..' exp        { ([mj AnnDotdot $2]
2486                                  ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
2487         | texp ',' exp '..' exp
2488                         { ([mj AnnComma $2,mj AnnDotdot $4]
2489                           ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
2490         | texp '|' flattenedpquals
2491                         { ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
2492
2493 -- We are reusing `lexps' and `flattenedpquals' from the list case.
2494
2495 -----------------------------------------------------------------------------
2496 -- Guards
2497
2498 guardquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2499     : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
2500
2501 guardquals1 :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2502     : guardquals1 ',' qual  {% addAnnotation (gl $ head $ unLoc $1) AnnComma
2503                                              (gl $2) >>
2504                                return (sLL $1 $> ($3 : unLoc $1)) }
2505     | qual                  { sL1 $1 [$1] }
2506
2507 -----------------------------------------------------------------------------
2508 -- Case alternatives
2509
2510 altslist :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2511         : '{'            alts '}'  { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2512                                                ,(reverse (snd $ unLoc $2))) }
2513         |     vocurly    alts  close { L (getLoc $2) (fst $ unLoc $2
2514                                         ,(reverse (snd $ unLoc $2))) }
2515         | '{'                 '}'    { noLoc ([moc $1,mcc $2],[]) }
2516         |     vocurly          close { noLoc ([],[]) }
2517
2518 alts    :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2519         : alts1                    { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
2520         | ';' alts                 { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
2521                                                ,snd $ unLoc $2) }
2522
2523 alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2524         : alts1 ';' alt         {% if null (snd $ unLoc $1)
2525                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2526                                                   ,[$3]))
2527                                      else (ams (head $ snd $ unLoc $1)
2528                                                (mj AnnSemi $2:(fst $ unLoc $1))
2529                                            >> return (sLL $1 $> ([],$3 : (snd $ unLoc $1))) ) }
2530         | alts1 ';'             {% if null (snd $ unLoc $1)
2531                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2532                                                   ,snd $ unLoc $1))
2533                                      else (ams (head $ snd $ unLoc $1)
2534                                                (mj AnnSemi $2:(fst $ unLoc $1))
2535                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
2536         | alt                   { sL1 $1 ([],[$1]) }
2537
2538 alt     :: { LMatch RdrName (LHsExpr RdrName) }
2539         : pat opt_sig alt_rhs      {%ams (sLL $1 $> (Match Nothing [$1] (snd $2)
2540                                                               (snd $ unLoc $3)))
2541                                          ((fst $2) ++ (fst $ unLoc $3))}
2542
2543 alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2544         : ralt wherebinds           { sLL $1 $> (fst $ unLoc $2,
2545                                             GRHSs (unLoc $1) (snd $ unLoc $2)) }
2546
2547 ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2548         : '->' exp            {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
2549                                      [mj AnnRarrow $1] }
2550         | gdpats              { sL1 $1 (reverse (unLoc $1)) }
2551
2552 gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2553         : gdpats gdpat                  { sLL $1 $> ($2 : unLoc $1) }
2554         | gdpat                         { sL1 $1 [$1] }
2555
2556 -- optional semi-colons between the guards of a MultiWayIf, because we use
2557 -- layout here, but we don't need (or want) the semicolon as a separator (#7783).
2558 gdpatssemi :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2559         : gdpatssemi gdpat optSemi  {% ams (sL (comb2 $1 $2) ($2 : unLoc $1))
2560                                            (map (\l -> mj AnnSemi l) $ fst $3) }
2561         | gdpat optSemi             {% ams (sL1 $1 [$1])
2562                                            (map (\l -> mj AnnSemi l) $ fst $2) }
2563
2564 -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
2565 -- generate the open brace in addition to the vertical bar in the lexer, and
2566 -- we don't need it.
2567 ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
2568          : '{' gdpatssemi '}'             { sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }
2569          |     gdpatssemi close           { sL1 $1 ([],unLoc $1) }
2570
2571 gdpat   :: { LGRHS RdrName (LHsExpr RdrName) }
2572         : '|' guardquals '->' exp
2573                                   {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2574                                          [mj AnnVbar $1,mj AnnRarrow $3] }
2575
2576 -- 'pat' recognises a pattern, including one with a bang at the top
2577 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
2578 -- Bangs inside are parsed as infix operator applications, so that
2579 -- we parse them right when bang-patterns are off
2580 pat     :: { LPat RdrName }
2581 pat     :  exp          {% checkPattern empty $1 }
2582         | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR
2583                                                      (sL1 $1 (HsVar bang_RDR)) $2)))
2584                                 [mj AnnBang $1] }
2585
2586 bindpat :: { LPat RdrName }
2587 bindpat :  exp            {% checkPattern
2588                                 (text "Possibly caused by a missing 'do'?") $1 }
2589         | '!' aexp        {% amms (checkPattern
2590                                      (text "Possibly caused by a missing 'do'?")
2591                                      (sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2)))
2592                                   [mj AnnBang $1] }
2593
2594 apat   :: { LPat RdrName }
2595 apat    : aexp                  {% checkPattern empty $1 }
2596         | '!' aexp              {% amms (checkPattern empty
2597                                             (sLL $1 $> (SectionR
2598                                                 (sL1 $1 (HsVar bang_RDR)) $2)))
2599                                         [mj AnnBang $1] }
2600
2601 apats  :: { [LPat RdrName] }
2602         : apat apats            { $1 : $2 }
2603         | {- empty -}           { [] }
2604
2605 -----------------------------------------------------------------------------
2606 -- Statement sequences
2607
2608 stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2609         : '{'           stmts '}'       { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2610                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
2611         |     vocurly   stmts close     { L (gl $2) (fst $ unLoc $2
2612                                                     ,reverse $ snd $ unLoc $2) }
2613
2614 --      do { ;; s ; s ; ; s ;; }
2615 -- The last Stmt should be an expression, but that's hard to enforce
2616 -- here, because we need too much lookahead if we see do { e ; }
2617 -- So we use BodyStmts throughout, and switch the last one over
2618 -- in ParseUtils.checkDo instead
2619 -- AZ: TODO check that we can retrieve multiple semis.
2620
2621 stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2622         : stmts ';' stmt  {% if null (snd $ unLoc $1)
2623                               then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2624                                                      ,$3 : (snd $ unLoc $1)))
2625                               else do
2626                                { ams (head $ snd $ unLoc $1) [mj AnnSemi $2]
2627                                ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(snd $ unLoc $1)) }}
2628
2629         | stmts ';'     {% if null (snd $ unLoc $1)
2630                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1),snd $ unLoc $1))
2631                              else do
2632                                { ams (head $ snd $ unLoc $1)
2633                                                [mj AnnSemi $2]
2634                                ; return $1 } }
2635         | stmt                   { sL1 $1 ([],[$1]) }
2636         | {- empty -}            { noLoc ([],[]) }
2637
2638
2639 -- For typing stmts at the GHCi prompt, where
2640 -- the input may consist of just comments.
2641 maybe_stmt :: { Maybe (LStmt RdrName (LHsExpr RdrName)) }
2642         : stmt                          { Just $1 }
2643         | {- nothing -}                 { Nothing }
2644
2645 stmt  :: { LStmt RdrName (LHsExpr RdrName) }
2646         : qual                          { $1 }
2647         | 'rec' stmtlist                {% ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
2648                                                (mj AnnRec $1:(fst $ unLoc $2)) }
2649
2650 qual  :: { LStmt RdrName (LHsExpr RdrName) }
2651     : bindpat '<-' exp                  {% ams (sLL $1 $> $ mkBindStmt $1 $3)
2652                                                [mj AnnLarrow $2] }
2653     | exp                               { sL1 $1 $ mkBodyStmt $1 }
2654     | 'let' binds                       {% ams (sLL $1 $>$ LetStmt (snd $ unLoc $2))
2655                                                (mj AnnLet $1:(fst $ unLoc $2)) }
2656
2657 -----------------------------------------------------------------------------
2658 -- Record Field Update/Construction
2659
2660 fbinds  :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2661         : fbinds1                       { $1 }
2662         | {- empty -}                   { ([],([], False)) }
2663
2664 fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2665         : fbind ',' fbinds1
2666                 {% addAnnotation (gl $1) AnnComma (gl $2) >>
2667                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
2668         | fbind                         { ([],([$1], False)) }
2669         | '..'                          { ([mj AnnDotdot $1],([],   True)) }
2670
2671 fbind   :: { LHsRecField RdrName (LHsExpr RdrName) }
2672         : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField (fmap mkFieldOcc $1) $3 False)
2673                                 [mj AnnEqual $2] }
2674                         -- RHS is a 'texp', allowing view patterns (Trac #6038)
2675                         -- and, incidentaly, sections.  Eg
2676                         -- f (R { x = show -> s }) = ...
2677
2678         | qvar          { sLL $1 $> $ HsRecField (fmap mkFieldOcc $1) placeHolderPunRhs True }
2679                         -- In the punning case, use a place-holder
2680                         -- The renamer fills in the final value
2681
2682 -----------------------------------------------------------------------------
2683 -- Implicit Parameter Bindings
2684
2685 dbinds  :: { Located [LIPBind RdrName] }
2686         : dbinds ';' dbind
2687                       {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2688                          return (let { this = $3; rest = unLoc $1 }
2689                               in rest `seq` this `seq` sLL $1 $> (this : rest)) }
2690         | dbinds ';'  {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2691                          return (sLL $1 $> (unLoc $1)) }
2692         | dbind                        { let this = $1 in this `seq` sL1 $1 [this] }
2693 --      | {- empty -}                  { [] }
2694
2695 dbind   :: { LIPBind RdrName }
2696 dbind   : ipvar '=' exp                {% ams (sLL $1 $> (IPBind (Left $1) $3))
2697                                               [mj AnnEqual $2] }
2698
2699 ipvar   :: { Located HsIPName }
2700         : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
2701
2702 -----------------------------------------------------------------------------
2703 -- Warnings and deprecations
2704
2705 name_boolformula_opt :: { LBooleanFormula (Located RdrName) }
2706         : name_boolformula          { $1 }
2707         | {- empty -}               { noLoc mkTrue }
2708
2709 name_boolformula :: { LBooleanFormula (Located RdrName) }
2710         : name_boolformula_and                      { $1 }
2711         | name_boolformula_and '|' name_boolformula
2712                            {% aa $1 (AnnVbar, $2)
2713                               >> return (sLL $1 $> (Or [$1,$3])) }
2714
2715 name_boolformula_and :: { LBooleanFormula (Located RdrName) }
2716         : name_boolformula_atom                             { $1 }
2717         | name_boolformula_atom ',' name_boolformula_and
2718                   {% aa $1 (AnnComma,$2) >> return (sLL $1 $> (And [$1,$3])) }
2719
2720 name_boolformula_atom :: { LBooleanFormula (Located RdrName) }
2721         : '(' name_boolformula ')'  {% ams (sLL $1 $> (Parens $2)) [mop $1,mcp $3] }
2722         | name_var                  { sL1 $1 (Var $1) }
2723
2724 namelist :: { Located [Located RdrName] }
2725 namelist : name_var              { sL1 $1 [$1] }
2726          | name_var ',' namelist {% addAnnotation (gl $1) AnnComma (gl $2) >>
2727                                     return (sLL $1 $> ($1 : unLoc $3)) }
2728
2729 name_var :: { Located RdrName }
2730 name_var : var { $1 }
2731          | con { $1 }
2732
2733 -----------------------------------------
2734 -- Data constructors
2735 -- There are two different productions here as lifted list constructors
2736 -- are parsed differently.
2737
2738 qcon_nowiredlist :: { Located RdrName }
2739         : gen_qcon                     { $1 }
2740         | sysdcon_nolist               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2741
2742 qcon :: { Located RdrName }
2743   : gen_qcon              { $1}
2744   | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2745
2746 gen_qcon :: { Located RdrName }
2747   : qconid                { $1 }
2748   | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))
2749                                    [mop $1,mj AnnVal $2,mcp $3] }
2750
2751 -- The case of '[:' ':]' is part of the production `parr'
2752
2753 con     :: { Located RdrName }
2754         : conid                 { $1 }
2755         | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))
2756                                        [mop $1,mj AnnVal $2,mcp $3] }
2757         | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2758
2759 con_list :: { Located [Located RdrName] }
2760 con_list : con                  { sL1 $1 [$1] }
2761          | con ',' con_list     {% addAnnotation (gl $1) AnnComma (gl $2) >>
2762                                    return (sLL $1 $> ($1 : unLoc $3)) }
2763
2764 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
2765         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
2766         | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
2767                                        (mop $1:mcp $3:(mcommas (fst $2))) }
2768         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
2769         | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
2770                                        (mo $1:mc $3:(mcommas (fst $2))) }
2771
2772 sysdcon :: { Located DataCon }
2773         : sysdcon_nolist                 { $1 }
2774         | '[' ']'               {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] }
2775
2776 conop :: { Located RdrName }
2777         : consym                { $1 }
2778         | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2))
2779                                        [mj AnnBackquote $1,mj AnnVal $2
2780                                        ,mj AnnBackquote $3] }
2781
2782 qconop :: { Located RdrName }
2783         : qconsym               { $1 }
2784         | '`' qconid '`'        {% ams (sLL $1 $> (unLoc $2))
2785                                        [mj AnnBackquote $1,mj AnnVal $2
2786                                        ,mj AnnBackquote $3] }
2787
2788 ----------------------------------------------------------------------------
2789 -- Type constructors
2790
2791
2792 -- See Note [Unit tuples] in HsTypes for the distinction
2793 -- between gtycon and ntgtycon
2794 gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
2795         : ntgtycon                     { $1 }
2796         | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)
2797                                               [mop $1,mcp $2] }
2798         | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)
2799                                               [mo $1,mc $2] }
2800
2801 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
2802         : oqtycon               { $1 }
2803         | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
2804                                                         (snd $2 + 1)))
2805                                        (mop $1:mcp $3:(mcommas (fst $2))) }
2806         | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
2807                                                         (snd $2 + 1)))
2808                                        (mo $1:mc $3:(mcommas (fst $2))) }
2809         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
2810                                        [mop $1,mj AnnRarrow $2,mcp $3] }
2811         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
2812         | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
2813         | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
2814                                         [mop $1,mj AnnTildehsh $2,mcp $3] }
2815
2816 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
2817                                 -- These can appear in export lists
2818         : qtycon                        { $1 }
2819         | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2))
2820                                                [mop $1,mj AnnVal $2,mcp $3] }
2821         | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)
2822                                                [mop $1,mj AnnTilde $2,mcp $3] }
2823
2824 oqtycon_no_varcon :: { Located RdrName }  -- Type constructor which cannot be mistaken
2825                                           -- for variable constructor in export lists
2826                                           -- see Note [Type constructors in export list]
2827         :  qtycon            { $1 }
2828         | '(' QCONSYM ')'    {% let name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2)
2829                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
2830         | '(' CONSYM ')'     {% let name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2)
2831                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
2832         | '(' ':' ')'        {% let name = sL1 $2 $! consDataCon_RDR
2833                                 in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
2834         | '(' '~' ')'        {% ams (sLL $1 $> $ eqTyCon_RDR) [mop $1,mj AnnTilde $2,mcp $3] }
2835
2836 {- Note [Type constructors in export list]
2837 ~~~~~~~~~~~~~~~~~~~~~
2838 Mixing type constructors and variable constructors in export lists introduces
2839 ambiguity in grammar: e.g. (*) may be both a type constructor and a function.
2840
2841 -XExplicitNamespaces allows to disambiguate by explicitly prefixing type
2842 constructors with 'type' keyword.
2843
2844 This ambiguity causes reduce/reduce conflicts in parser, which are always
2845 resolved in favour of variable constructors. To get rid of conflicts we demand
2846 that ambigous type constructors (those, which are formed by the same
2847 productions as variable constructors) are always prefixed with 'type' keyword.
2848 Unambigous type constructors may occur both with or without 'type' keyword.
2849 -}
2850
2851 qtyconop :: { Located RdrName } -- Qualified or unqualified
2852         : qtyconsym                     { $1 }
2853         | '`' qtycon '`'                {% ams (sLL $1 $> (unLoc $2))
2854                                                [mj AnnBackquote $1,mj AnnVal $2
2855                                                ,mj AnnBackquote $3] }
2856
2857 qtycon :: { Located RdrName }   -- Qualified or unqualified
2858         : QCONID            { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
2859         | tycon             { $1 }
2860
2861 tycon   :: { Located RdrName }  -- Unqualified
2862         : CONID                   { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
2863
2864 qtyconsym :: { Located RdrName }
2865         : QCONSYM            { sL1 $1 $! mkQual tcClsName (getQCONSYM $1) }
2866         | QVARSYM            { sL1 $1 $! mkQual tcClsName (getQVARSYM $1) }
2867         | tyconsym           { $1 }
2868
2869 -- Does not include "!", because that is used for strictness marks
2870 --               or ".", because that separates the quantified type vars from the rest
2871 tyconsym :: { Located RdrName }
2872         : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
2873         | VARSYM                { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
2874         | ':'                   { sL1 $1 $! consDataCon_RDR }
2875         | '*'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "*") }
2876         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
2877
2878
2879 -----------------------------------------------------------------------------
2880 -- Operators
2881
2882 op      :: { Located RdrName }   -- used in infix decls
2883         : varop                 { $1 }
2884         | conop                 { $1 }
2885
2886 varop   :: { Located RdrName }
2887         : varsym                { $1 }
2888         | '`' varid '`'         {% ams (sLL $1 $> (unLoc $2))
2889                                        [mj AnnBackquote $1,mj AnnVal $2
2890                                        ,mj AnnBackquote $3] }
2891
2892 qop     :: { LHsExpr RdrName }   -- used in sections
2893         : qvarop                { sL1 $1 $ HsVar (unLoc $1) }
2894         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2895
2896 qopm    :: { LHsExpr RdrName }   -- used in sections
2897         : qvaropm               { sL1 $1 $ HsVar (unLoc $1) }
2898         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2899
2900 qvarop :: { Located RdrName }
2901         : qvarsym               { $1 }
2902         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
2903                                        [mj AnnBackquote $1,mj AnnVal $2
2904                                        ,mj AnnBackquote $3] }
2905
2906 qvaropm :: { Located RdrName }
2907         : qvarsym_no_minus      { $1 }
2908         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
2909                                        [mj AnnBackquote $1,mj AnnVal $2
2910                                        ,mj AnnBackquote $3] }
2911
2912 -----------------------------------------------------------------------------
2913 -- Type variables
2914
2915 tyvar   :: { Located RdrName }
2916 tyvar   : tyvarid               { $1 }
2917
2918 tyvarop :: { Located RdrName }
2919 tyvarop : '`' tyvarid '`'       {% ams (sLL $1 $> (unLoc $2))
2920                                        [mj AnnBackquote $1,mj AnnVal $2
2921                                        ,mj AnnBackquote $3] }
2922         | '.'                   {% parseErrorSDoc (getLoc $1)
2923                                       (vcat [ptext (sLit "Illegal symbol '.' in type"),
2924                                              ptext (sLit "Perhaps you intended to use RankNTypes or a similar language"),
2925                                              ptext (sLit "extension to enable explicit-forall syntax: forall <tvs>. <type>")])
2926                                 }
2927
2928 tyvarid :: { Located RdrName }
2929         : VARID            { sL1 $1 $! mkUnqual tvName (getVARID $1) }
2930         | special_id       { sL1 $1 $! mkUnqual tvName (unLoc $1) }
2931         | 'unsafe'         { sL1 $1 $! mkUnqual tvName (fsLit "unsafe") }
2932         | 'safe'           { sL1 $1 $! mkUnqual tvName (fsLit "safe") }
2933         | 'interruptible'  { sL1 $1 $! mkUnqual tvName (fsLit "interruptible") }
2934
2935 -----------------------------------------------------------------------------
2936 -- Variables
2937
2938 var     :: { Located RdrName }
2939         : varid                 { $1 }
2940         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
2941                                        [mop $1,mj AnnVal $2,mcp $3] }
2942
2943 qvar    :: { Located RdrName }
2944         : qvarid                { $1 }
2945         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
2946                                        [mop $1,mj AnnVal $2,mcp $3] }
2947         | '(' qvarsym1 ')'      {% ams (sLL $1 $> (unLoc $2))
2948                                        [mop $1,mj AnnVal $2,mcp $3] }
2949 -- We've inlined qvarsym here so that the decision about
2950 -- whether it's a qvar or a var can be postponed until
2951 -- *after* we see the close paren.
2952
2953 qvarid :: { Located RdrName }
2954         : varid               { $1 }
2955         | QVARID              { sL1 $1 $! mkQual varName (getQVARID $1) }
2956
2957 -- Note that 'role' and 'family' get lexed separately regardless of
2958 -- the use of extensions. However, because they are listed here, this
2959 -- is OK and they can be used as normal varids.
2960 -- See Note [Lexing type pseudo-keywords] in Lexer.x
2961 varid :: { Located RdrName }
2962         : VARID            { sL1 $1 $! mkUnqual varName (getVARID $1) }
2963         | special_id       { sL1 $1 $! mkUnqual varName (unLoc $1) }
2964         | 'unsafe'         { sL1 $1 $! mkUnqual varName (fsLit "unsafe") }
2965         | 'safe'           { sL1 $1 $! mkUnqual varName (fsLit "safe") }
2966         | 'interruptible'  { sL1 $1 $! mkUnqual varName (fsLit "interruptible")}
2967         | 'forall'         { sL1 $1 $! mkUnqual varName (fsLit "forall") }
2968         | 'family'         { sL1 $1 $! mkUnqual varName (fsLit "family") }
2969         | 'role'           { sL1 $1 $! mkUnqual varName (fsLit "role") }
2970
2971 qvarsym :: { Located RdrName }
2972         : varsym                { $1 }
2973         | qvarsym1              { $1 }
2974
2975 qvarsym_no_minus :: { Located RdrName }
2976         : varsym_no_minus       { $1 }
2977         | qvarsym1              { $1 }
2978
2979 qvarsym1 :: { Located RdrName }
2980 qvarsym1 : QVARSYM              { sL1 $1 $ mkQual varName (getQVARSYM $1) }
2981
2982 varsym :: { Located RdrName }
2983         : varsym_no_minus       { $1 }
2984         | '-'                   { sL1 $1 $ mkUnqual varName (fsLit "-") }
2985
2986 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
2987         : VARSYM               { sL1 $1 $ mkUnqual varName (getVARSYM $1) }
2988         | special_sym          { sL1 $1 $ mkUnqual varName (unLoc $1) }
2989
2990
2991 -- These special_ids are treated as keywords in various places,
2992 -- but as ordinary ids elsewhere.   'special_id' collects all these
2993 -- except 'unsafe', 'interruptible', 'forall', 'family', and 'role',
2994 -- whose treatment differs depending on context
2995 special_id :: { Located FastString }
2996 special_id
2997         : 'as'                  { sL1 $1 (fsLit "as") }
2998         | 'qualified'           { sL1 $1 (fsLit "qualified") }
2999         | 'hiding'              { sL1 $1 (fsLit "hiding") }
3000         | 'export'              { sL1 $1 (fsLit "export") }
3001         | 'label'               { sL1 $1 (fsLit "label")  }
3002         | 'dynamic'             { sL1 $1 (fsLit "dynamic") }
3003         | 'stdcall'             { sL1 $1 (fsLit "stdcall") }
3004         | 'ccall'               { sL1 $1 (fsLit "ccall") }
3005         | 'capi'                { sL1 $1 (fsLit "capi") }
3006         | 'prim'                { sL1 $1 (fsLit "prim") }
3007         | 'javascript'          { sL1 $1 (fsLit "javascript") }
3008         | 'group'               { sL1 $1 (fsLit "group") }
3009
3010 special_sym :: { Located FastString }
3011 special_sym : '!'       {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
3012             | '.'       { sL1 $1 (fsLit ".") }
3013             | '*'       { sL1 $1 (fsLit "*") }
3014
3015 -----------------------------------------------------------------------------
3016 -- Data constructors
3017
3018 qconid :: { Located RdrName }   -- Qualified or unqualified
3019         : conid              { $1 }
3020         | QCONID             { sL1 $1 $! mkQual dataName (getQCONID $1) }
3021
3022 conid   :: { Located RdrName }
3023         : CONID                { sL1 $1 $ mkUnqual dataName (getCONID $1) }
3024
3025 qconsym :: { Located RdrName }  -- Qualified or unqualified
3026         : consym               { $1 }
3027         | QCONSYM              { sL1 $1 $ mkQual dataName (getQCONSYM $1) }
3028
3029 consym :: { Located RdrName }
3030         : CONSYM              { sL1 $1 $ mkUnqual dataName (getCONSYM $1) }
3031
3032         -- ':' means only list cons
3033         | ':'                { sL1 $1 $ consDataCon_RDR }
3034
3035
3036 -----------------------------------------------------------------------------
3037 -- Literals
3038
3039 literal :: { Located HsLit }
3040         : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }
3041         | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)
3042                                                    $ getSTRING $1 }
3043         | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)
3044                                                    $ getPRIMINTEGER $1 }
3045         | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)
3046                                                    $ getPRIMWORD $1 }
3047         | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)
3048                                                    $ getPRIMCHAR $1 }
3049         | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
3050                                                    $ getPRIMSTRING $1 }
3051         | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
3052         | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
3053
3054 -----------------------------------------------------------------------------
3055 -- Layout
3056
3057 close :: { () }
3058         : vccurly               { () } -- context popped in lexer.
3059         | error                 {% popContext }
3060
3061 -----------------------------------------------------------------------------
3062 -- Miscellaneous (mostly renamings)
3063
3064 modid   :: { Located ModuleName }
3065         : CONID                 { sL1 $1 $ mkModuleNameFS (getCONID $1) }
3066         | QCONID                { sL1 $1 $ let (mod,c) = getQCONID $1 in
3067                                   mkModuleNameFS
3068                                    (mkFastString
3069                                      (unpackFS mod ++ '.':unpackFS c))
3070                                 }
3071
3072 commas :: { ([SrcSpan],Int) }   -- One or more commas
3073         : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }
3074         | ','                    { ([gl $1],1) }
3075
3076 -----------------------------------------------------------------------------
3077 -- Documentation comments
3078
3079 docnext :: { LHsDocString }
3080   : DOCNEXT {% return (sL1 $1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
3081
3082 docprev :: { LHsDocString }
3083   : DOCPREV {% return (sL1 $1 (HsDocString (mkFastString (getDOCPREV $1)))) }
3084
3085 docnamed :: { Located (String, HsDocString) }
3086   : DOCNAMED {%
3087       let string = getDOCNAMED $1
3088           (name, rest) = break isSpace string
3089       in return (sL1 $1 (name, HsDocString (mkFastString rest))) }
3090
3091 docsection :: { Located (Int, HsDocString) }
3092   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
3093         return (sL1 $1 (n, HsDocString (mkFastString doc))) }
3094
3095 moduleheader :: { Maybe LHsDocString }
3096         : DOCNEXT {% let string = getDOCNEXT $1 in
3097                      return (Just (sL1 $1 (HsDocString (mkFastString string)))) }
3098
3099 maybe_docprev :: { Maybe LHsDocString }
3100         : docprev                       { Just $1 }
3101         | {- empty -}                   { Nothing }
3102
3103 maybe_docnext :: { Maybe LHsDocString }
3104         : docnext                       { Just $1 }
3105         | {- empty -}                   { Nothing }
3106
3107 {
3108 happyError :: P a
3109 happyError = srcParseFail
3110
3111 getVARID        (L _ (ITvarid    x)) = x
3112 getCONID        (L _ (ITconid    x)) = x
3113 getVARSYM       (L _ (ITvarsym   x)) = x
3114 getCONSYM       (L _ (ITconsym   x)) = x
3115 getQVARID       (L _ (ITqvarid   x)) = x
3116 getQCONID       (L _ (ITqconid   x)) = x
3117 getQVARSYM      (L _ (ITqvarsym  x)) = x
3118 getQCONSYM      (L _ (ITqconsym  x)) = x
3119 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
3120 getCHAR         (L _ (ITchar   _ x)) = x
3121 getSTRING       (L _ (ITstring _ x)) = x
3122 getINTEGER      (L _ (ITinteger _ x)) = x
3123 getRATIONAL     (L _ (ITrational x)) = x
3124 getPRIMCHAR     (L _ (ITprimchar _ x)) = x
3125 getPRIMSTRING   (L _ (ITprimstring _ x)) = x
3126 getPRIMINTEGER  (L _ (ITprimint  _ x)) = x
3127 getPRIMWORD     (L _ (ITprimword _ x)) = x
3128 getPRIMFLOAT    (L _ (ITprimfloat x)) = x
3129 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
3130 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
3131 getTH_ID_TY_SPLICE (L _ (ITidTyEscape x)) = x
3132 getINLINE       (L _ (ITinline_prag _ inl conl)) = (inl,conl)
3133 getSPEC_INLINE  (L _ (ITspec_inline_prag _ True))  = (Inline,  FunLike)
3134 getSPEC_INLINE  (L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)
3135
3136 getDOCNEXT (L _ (ITdocCommentNext x)) = x
3137 getDOCPREV (L _ (ITdocCommentPrev x)) = x
3138 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
3139 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
3140
3141 getCHARs        (L _ (ITchar       src _)) = src
3142 getSTRINGs      (L _ (ITstring     src _)) = src
3143 getINTEGERs     (L _ (ITinteger    src _)) = src
3144 getPRIMCHARs    (L _ (ITprimchar   src _)) = src
3145 getPRIMSTRINGs  (L _ (ITprimstring src _)) = src
3146 getPRIMINTEGERs (L _ (ITprimint    src _)) = src
3147 getPRIMWORDs    (L _ (ITprimword   src _)) = src
3148
3149 -- See Note [Pragma source text] in BasicTypes for the following
3150 getINLINE_PRAGs       (L _ (ITinline_prag       src _ _)) = src
3151 getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src
3152 getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src
3153 getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src
3154 getRULES_PRAGs        (L _ (ITrules_prag        src)) = src
3155 getWARNING_PRAGs      (L _ (ITwarning_prag      src)) = src
3156 getDEPRECATED_PRAGs   (L _ (ITdeprecated_prag   src)) = src
3157 getSCC_PRAGs          (L _ (ITscc_prag          src)) = src
3158 getGENERATED_PRAGs    (L _ (ITgenerated_prag    src)) = src
3159 getCORE_PRAGs         (L _ (ITcore_prag         src)) = src
3160 getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src
3161 getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src
3162 getANN_PRAGs          (L _ (ITann_prag          src)) = src
3163 getVECT_PRAGs         (L _ (ITvect_prag         src)) = src
3164 getVECT_SCALAR_PRAGs  (L _ (ITvect_scalar_prag  src)) = src
3165 getNOVECT_PRAGs       (L _ (ITnovect_prag       src)) = src
3166 getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src
3167 getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src
3168 getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src
3169 getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src
3170 getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src
3171 getCTYPEs             (L _ (ITctype             src)) = src
3172
3173 getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l)
3174
3175 getSCC :: Located Token -> P FastString
3176 getSCC lt = do let s = getSTRING lt
3177                    err = "Spaces are not allowed in SCCs"
3178                -- We probably actually want to be more restrictive than this
3179                if ' ' `elem` unpackFS s
3180                    then failSpanMsgP (getLoc lt) (text err)
3181                    else return s
3182
3183 -- Utilities for combining source spans
3184 comb2 :: Located a -> Located b -> SrcSpan
3185 comb2 a b = a `seq` b `seq` combineLocs a b
3186
3187 comb3 :: Located a -> Located b -> Located c -> SrcSpan
3188 comb3 a b c = a `seq` b `seq` c `seq`
3189     combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
3190
3191 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
3192 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
3193     (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
3194                 combineSrcSpans (getLoc c) (getLoc d))
3195
3196 -- strict constructor version:
3197 {-# INLINE sL #-}
3198 sL :: SrcSpan -> a -> Located a
3199 sL span a = span `seq` a `seq` L span a
3200
3201 -- See Note [Adding location info] for how these utility functions are used
3202
3203 -- replaced last 3 CPP macros in this file
3204 {-# INLINE sL0 #-}
3205 sL0 :: a -> Located a
3206 sL0 = L noSrcSpan       -- #define L0   L noSrcSpan
3207
3208 {-# INLINE sL1 #-}
3209 sL1 :: Located a -> b -> Located b
3210 sL1 x = sL (getLoc x)   -- #define sL1   sL (getLoc $1)
3211
3212 {-# INLINE sLL #-}
3213 sLL :: Located a -> Located b -> c -> Located c
3214 sLL x y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
3215
3216 {- Note [Adding location info]
3217    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
3218
3219 This is done using the three functions below, sL0, sL1
3220 and sLL.  Note that these functions were mechanically
3221 converted from the three macros that used to exist before,
3222 namely L0, L1 and LL.
3223
3224 They each add a SrcSpan to their argument.
3225
3226    sL0  adds 'noSrcSpan', used for empty productions
3227      -- This doesn't seem to work anymore -=chak
3228
3229    sL1  for a production with a single token on the lhs.  Grabs the SrcSpan
3230         from that token.
3231
3232    sLL  for a production with >1 token on the lhs.  Makes up a SrcSpan from
3233         the first and last tokens.
3234
3235 These suffice for the majority of cases.  However, we must be
3236 especially careful with empty productions: sLL won't work if the first
3237 or last token on the lhs can represent an empty span.  In these cases,
3238 we have to calculate the span using more of the tokens from the lhs, eg.
3239
3240         | 'newtype' tycl_hdr '=' newconstr deriving
3241                 { L (comb3 $1 $4 $5)
3242                     (mkTyData NewType (unLoc $2) $4 (unLoc $5)) }
3243
3244 We provide comb3 and comb4 functions which are useful in such cases.
3245
3246 Be careful: there's no checking that you actually got this right, the
3247 only symptom will be that the SrcSpans of your syntax will be
3248 incorrect.