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