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