Lexer.x and Parser.y: delete dead code
[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 ';' gadt_constrs
1874                   {% addAnnotation (gl $1) AnnSemi (gl $2)
1875                      >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
1876         | gadt_constr                   { 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 :: { LConDecl RdrName }
1886                    -- Returns a list because of:   C,D :: ty
1887         : con_list '::' sigtype
1888                 {% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3
1889                       ; ams (sLL $1 $> $ gadtDecl)
1890                             (mj AnnDcolon $2:anns) } }
1891
1892                 -- Deprecated syntax for GADT record declarations
1893         | oqtycon '{' fielddecls '}' '::' sigtype
1894                 {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 (noLoc $3) $6
1895                       ; cd' <- checkRecordSyntax cd
1896                       ; ams (L (comb2 $1 $6) (unLoc cd'))
1897                             [moc $2,mcc $4,mj AnnDcolon $5] } }
1898
1899 constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
1900         : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
1901                                                      ,addConDocs (unLoc $3) $1)}
1902
1903 constrs1 :: { Located [LConDecl RdrName] }
1904         : constrs1 maybe_docnext '|' maybe_docprev constr
1905             {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $3)
1906                >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
1907         | constr                                          { sL1 $1 [$1] }
1908
1909 constr :: { LConDecl RdrName }
1910         : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1911                 {% ams (let (con,details) = unLoc $5 in
1912                   addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con
1913                                                    (snd $ unLoc $2) $3 details))
1914                             ($1 `mplus` $6))
1915                         (mj AnnDarrow $4:(fst $ unLoc $2)) }
1916         | maybe_docnext forall constr_stuff maybe_docprev
1917                 {% ams ( let (con,details) = unLoc $3 in
1918                   addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con
1919                                            (snd $ unLoc $2) (noLoc []) details))
1920                             ($1 `mplus` $4))
1921                        (fst $ unLoc $2) }
1922
1923 forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) }
1924         : 'forall' tv_bndrs '.'       { sLL $1 $> ([mj AnnForall $1,mj AnnDot $3],$2) }
1925         | {- empty -}                 { noLoc ([],[]) }
1926
1927 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1928 -- We parse the constructor declaration
1929 --      C t1 t2
1930 -- as a btype (treating C as a type constructor) and then convert C to be
1931 -- a data constructor.  Reason: it might continue like this:
1932 --      C t1 t2 %: D Int
1933 -- in which case C really would be a type constructor.  We can't resolve this
1934 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
1935         : btype                         {% splitCon $1 >>= return.sLL $1 $> }
1936         | btype conop btype             {  sLL $1 $> ($2, InfixCon $1 $3) }
1937
1938 fielddecls :: { [LConDeclField RdrName] }
1939         : {- empty -}     { [] }
1940         | fielddecls1     { $1 }
1941
1942 fielddecls1 :: { [LConDeclField RdrName] }
1943         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
1944             {% addAnnotation (gl $1) AnnComma (gl $3) >>
1945                return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
1946         | fielddecl   { [$1] }
1947
1948 fielddecl :: { LConDeclField RdrName }
1949                                               -- A list because of   f,g :: Int
1950         : maybe_docnext sig_vars '::' ctype maybe_docprev
1951             {% ams (L (comb2 $2 $4)
1952                       (ConDeclField (reverse (unLoc $2)) $4 ($1 `mplus` $5)))
1953                    [mj AnnDcolon $3] }
1954
1955 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1956 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1957 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1958 -- We don't allow a context, but that's sorted out by the type checker.
1959 deriving :: { Located (Maybe (Located [LHsType RdrName])) }
1960         : {- empty -}             { noLoc Nothing }
1961         | 'deriving' qtycon       {% aljs ( let { L loc tv = $2 }
1962                                             in (sLL $1 $> (Just (sLL $1 $>
1963                                                        [L loc (HsTyVar tv)]))))
1964                                           [mj AnnDeriving $1] }
1965         | 'deriving' '(' ')'      {% aljs (sLL $1 $> (Just (sLL $1 $> [])))
1966                                           [mj AnnDeriving $1,mop $2,mcp $3] }
1967
1968         | 'deriving' '(' inst_types1 ')'  {% aljs (sLL $1 $> (Just (sLL $1 $> $3)))
1969                                                  [mj AnnDeriving $1,mop $2,mcp $4] }
1970              -- Glasgow extension: allow partial
1971              -- applications in derivings
1972
1973 -----------------------------------------------------------------------------
1974 -- Value definitions
1975
1976 {- Note [Declaration/signature overlap]
1977 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1978 There's an awkward overlap with a type signature.  Consider
1979         f :: Int -> Int = ...rhs...
1980    Then we can't tell whether it's a type signature or a value
1981    definition with a result signature until we see the '='.
1982    So we have to inline enough to postpone reductions until we know.
1983 -}
1984
1985 {-
1986   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1987   instead of qvar, we get another shift/reduce-conflict. Consider the
1988   following programs:
1989
1990      { (^^) :: Int->Int ; }          Type signature; only var allowed
1991
1992      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
1993                                      qvar allowed (because of instance decls)
1994
1995   We can't tell whether to reduce var to qvar until after we've read the signatures.
1996 -}
1997
1998 docdecl :: { LHsDecl RdrName }
1999         : docdecld { sL1 $1 (DocD (unLoc $1)) }
2000
2001 docdecld :: { LDocDecl }
2002         : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
2003         | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
2004         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
2005         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
2006
2007 decl_no_th :: { LHsDecl RdrName }
2008         : sigdecl               { $1 }
2009
2010         | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar bang_RDR)) $2) };
2011                                         pat <- checkPattern empty e;
2012                                         _ <- ams (sLL $1 $> ())
2013                                                (fst $ unLoc $3);
2014                                         return $ sLL $1 $> $ ValD $
2015                                             PatBind pat (snd $ unLoc $3)
2016                                                     placeHolderType
2017                                                     placeHolderNames
2018                                                     ([],[]) } }
2019                                 -- Turn it all into an expression so that
2020                                 -- checkPattern can check that bangs are enabled
2021
2022         | infixexp opt_sig rhs  {% do { (ann,r) <- checkValDef empty $1 (snd $2) $3;
2023                                         let { l = comb2 $1 $> };
2024                                         case r of {
2025                                           (FunBind n _ _ _ _ _) ->
2026                                                 ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
2027                                           (PatBind (L lh _lhs) _rhs _ _ _) ->
2028                                                 ams (L lh ()) (fst $2) >> return () } ;
2029                                         _ <- ams (L l ()) (ann ++ (fst $ unLoc $3));
2030                                         return $! (sL l $ ValD r) } }
2031         | pattern_synonym_decl  { $1 }
2032         | docdecl               { $1 }
2033
2034 decl    :: { LHsDecl RdrName }
2035         : decl_no_th            { $1 }
2036
2037         -- Why do we only allow naked declaration splices in top-level
2038         -- declarations and not here? Short answer: because readFail009
2039         -- fails terribly with a panic in cvBindsAndSigs otherwise.
2040         | splice_exp            { sLL $1 $> $ mkSpliceDecl $1 }
2041
2042 rhs     :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2043         : '=' exp wherebinds    { sL (comb3 $1 $2 $3)
2044                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
2045                                     ,GRHSs (unguardedRHS (comb3 $1 $2 $3) $2)
2046                                    (snd $ unLoc $3)) }
2047         | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
2048                                     ,GRHSs (reverse (unLoc $1))
2049                                                     (snd $ unLoc $2)) }
2050
2051 gdrhs :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2052         : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
2053         | gdrh                  { sL1 $1 [$1] }
2054
2055 gdrh :: { LGRHS RdrName (LHsExpr RdrName) }
2056         : '|' guardquals '=' exp  {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2057                                          [mj AnnVbar $1,mj AnnEqual $3] }
2058
2059 sigdecl :: { LHsDecl RdrName }
2060         :
2061         -- See Note [Declaration/signature overlap] for why we need infixexp here
2062           infixexp '::' sigtypedoc
2063                         {% do s <- checkValSig $1 $3
2064                         ; _ <- ams (sLL $1 $> ()) [mj AnnDcolon $2]
2065                         ; return (sLL $1 $> $ SigD s) }
2066
2067         | var ',' sig_vars '::' sigtypedoc
2068            {% do { let sig = TypeSig ($1 : reverse (unLoc $3)) $5 PlaceHolder
2069                  ; addAnnotation (gl $1) AnnComma (gl $2)
2070                  ; ams ( sLL $1 $> $ SigD sig )
2071                        [mj AnnDcolon $4] } }
2072
2073         | infix prec ops
2074               {% ams (sLL $1 $> $ SigD
2075                         (FixSig (FixitySig (fromOL $ unLoc $3)
2076                                 (Fixity (unLoc $2) (unLoc $1)))))
2077                      [mj AnnInfix $1,mj AnnVal $2] }
2078
2079         | pattern_synonym_sig   { sLL $1 $> . SigD . unLoc $ $1 }
2080
2081         | '{-# INLINE' activation qvar '#-}'
2082                 {% ams ((sLL $1 $> $ SigD (InlineSig $3
2083                             (mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
2084                                             (snd $2)))))
2085                        ((mo $1:fst $2) ++ [mc $4]) }
2086
2087         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
2088              {% ams (
2089                  let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
2090                                              (EmptyInlineSpec, FunLike) (snd $2)
2091                   in sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag))
2092                     (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
2093
2094         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
2095              {% ams (sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
2096                                (mkInlinePragma (getSPEC_INLINE_PRAGs $1)
2097                                                (getSPEC_INLINE $1) (snd $2))))
2098                        (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
2099
2100         | '{-# SPECIALISE' 'instance' inst_type '#-}'
2101                 {% ams (sLL $1 $>
2102                                   $ SigD (SpecInstSig (getSPEC_PRAGs $1) $3))
2103                        [mo $1,mj AnnInstance $2,mc $4] }
2104
2105         -- AZ TODO: Do we need locations in the name_formula_opt?
2106         -- A minimal complete definition
2107         | '{-# MINIMAL' name_boolformula_opt '#-}'
2108             {% ams (sLL $1 $> $ SigD (MinimalSig (getMINIMAL_PRAGs $1) (snd $2)))
2109                    (mo $1:mc $3:fst $2) }
2110
2111 activation :: { ([AddAnn],Maybe Activation) }
2112         : {- empty -}                           { ([],Nothing) }
2113         | explicit_activation                   { (fst $1,Just (snd $1)) }
2114
2115 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
2116         : '[' INTEGER ']'       { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
2117                                   ,ActiveAfter  (fromInteger (getINTEGER $2))) }
2118         | '[' '~' INTEGER ']'   { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
2119                                                  ,mj AnnCloseS $4]
2120                                   ,ActiveBefore (fromInteger (getINTEGER $3))) }
2121
2122 -----------------------------------------------------------------------------
2123 -- Expressions
2124
2125 quasiquote :: { Located (HsSplice RdrName) }
2126         : TH_QUASIQUOTE   { let { loc = getLoc $1
2127                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
2128                                 ; quoterId = mkUnqual varName quoter }
2129                             in sL1 $1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2130         | TH_QQUASIQUOTE  { let { loc = getLoc $1
2131                                 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
2132                                 ; quoterId = mkQual varName (qual, quoter) }
2133                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
2134
2135 exp   :: { LHsExpr RdrName }
2136         : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 $3 PlaceHolder)
2137                                        [mj AnnDcolon $2] }
2138         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2139                                                         HsFirstOrderApp True)
2140                                        [mj Annlarrowtail $2] }
2141         | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2142                                                       HsFirstOrderApp False)
2143                                        [mj Annrarrowtail $2] }
2144         | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
2145                                                       HsHigherOrderApp True)
2146                                        [mj AnnLarrowtail $2] }
2147         | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
2148                                                       HsHigherOrderApp False)
2149                                        [mj AnnRarrowtail $2] }
2150         | infixexp              { $1 }
2151
2152 infixexp :: { LHsExpr RdrName }
2153         : exp10                   { $1 }
2154         | infixexp qop exp10      {% ams (sLL $1 $>
2155                                              (OpApp $1 $2 placeHolderFixity $3))
2156                                          [mj AnnVal $2] }
2157                  -- AnnVal annotation for NPlusKPat, which discards the operator
2158
2159
2160 exp10 :: { LHsExpr RdrName }
2161         : '\\' apat apats opt_asig '->' exp
2162                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
2163                             [sLL $1 $> $ Match Nothing ($2:$3) (snd $4) (unguardedGRHSs $6)]))
2164                           (mj AnnLam $1:mj AnnRarrow $5:(fst $4)) }
2165         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
2166                                                (mj AnnLet $1:mj AnnIn $3
2167                                                  :(fst $ unLoc $2)) }
2168         | '\\' 'lcase' altslist
2169             {% ams (sLL $1 $> $ HsLamCase placeHolderType
2170                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
2171                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
2172         | 'if' exp optSemi 'then' exp optSemi 'else' exp
2173                            {% checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
2174                               ams (sLL $1 $> $ mkHsIf $2 $5 $8)
2175                                   (mj AnnIf $1:mj AnnThen $4
2176                                      :mj AnnElse $7
2177                                      :(map (\l -> mj AnnSemi l) (fst $3))
2178                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
2179         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
2180                                            ams (sLL $1 $> $ HsMultiIf
2181                                                      placeHolderType
2182                                                      (reverse $ snd $ unLoc $2))
2183                                                (mj AnnIf $1:(fst $ unLoc $2)) }
2184         | 'case' exp 'of' altslist      {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
2185                                                    FromSource (snd $ unLoc $4)))
2186                                                (mj AnnCase $1:mj AnnOf $3
2187                                                   :(fst $ unLoc $4)) }
2188         | '-' fexp                      {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
2189                                                [mj AnnMinus $1] }
2190
2191         | 'do' stmtlist              {% ams (L (comb2 $1 $2)
2192                                                (mkHsDo DoExpr (snd $ unLoc $2)))
2193                                                (mj AnnDo $1:(fst $ unLoc $2)) }
2194         | 'mdo' stmtlist            {% ams (L (comb2 $1 $2)
2195                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
2196                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
2197
2198         | scc_annot exp        {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2199                                       (fst $ fst $ unLoc $1) }
2200
2201         | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
2202                                       (fst $ fst $ unLoc $1) }
2203
2204         | 'proc' aexp '->' exp
2205                        {% checkPattern empty $2 >>= \ p ->
2206                            checkCommand $4 >>= \ cmd ->
2207                            ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
2208                                                 placeHolderType []))
2209                                             -- TODO: is LL right here?
2210                                [mj AnnProc $1,mj AnnRarrow $3] }
2211
2212         | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getSTRINGs $2,getSTRING $2) $4)
2213                                               [mo $1,mj AnnVal $2
2214                                               ,mc $3] }
2215                                           -- hdaume: core annotation
2216         | fexp                         { $1 }
2217
2218         -- parsing error messages go below here
2219         | '\\' apat apats opt_asig '->' error        {% parseErrorSDoc (combineLocs $1 $5) $ text
2220                                                         "parse error in lambda: no expression after '->'"
2221                                                      }
2222         | '\\' error                                 {% parseErrorSDoc (getLoc $1) $ text
2223                                                         "parse error: naked lambda expression '\'"
2224                                                      }
2225         | 'let' binds 'in' error                     {% parseErrorSDoc (combineLocs $1 $2) $ text
2226                                                         "parse error in let binding: missing expression after 'in'"
2227                                                      }
2228         | 'let' binds error                          {% parseErrorSDoc (combineLocs $1 $2) $ text
2229                                                         "parse error in let binding: missing required 'in'"
2230                                                      }
2231         | 'let' error                                {% parseErrorSDoc (getLoc $1) $ text
2232                                                         "parse error: naked let binding"
2233                                                      }
2234         | 'if' exp optSemi 'then' exp optSemi
2235           'else' error                               {% hintIf (combineLocs $1 $5) "else clause empty" }
2236         | 'if' exp optSemi 'then' exp optSemi error  {% hintIf (combineLocs $1 $5) "missing required else clause" }
2237         | 'if' exp optSemi 'then' error              {% hintIf (combineLocs $1 $2) "then clause empty" }
2238         | 'if' exp optSemi error                     {% hintIf (combineLocs $1 $2) "missing required then and else clauses" }
2239         | 'if' error                                 {% hintIf (getLoc $1) "naked if statement" }
2240         | 'case' exp 'of' error                      {% parseErrorSDoc (combineLocs $1 $2) $ text
2241                                                         "parse error in case statement: missing list after '->'"
2242                                                      }
2243         | 'case' exp error                           {% parseErrorSDoc (combineLocs $1 $2) $ text
2244                                                         "parse error in case statement: missing required 'of'"
2245                                                      }
2246         | 'case' error                               {% parseErrorSDoc (getLoc $1) $ text
2247                                                         "parse error: naked case statement"
2248                                                      }
2249 optSemi :: { ([Located a],Bool) }
2250         : ';'         { ([$1],True) }
2251         | {- empty -} { ([],False) }
2252
2253 scc_annot :: { Located (([AddAnn],SourceText),(SourceText,FastString)) }
2254         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
2255                                             ; return $ sLL $1 $>
2256                                                (([mo $1,mj AnnValStr $2
2257                                                 ,mc $3],getSCC_PRAGs $1),(getSTRINGs $2,scc)) }
2258         | '{-# SCC' VARID  '#-}'      { sLL $1 $> (([mo $1,mj AnnVal $2
2259                                          ,mc $3],getSCC_PRAGs $1)
2260                                         ,(unpackFS $ getVARID $2,getVARID $2)) }
2261
2262 hpc_annot :: { Located (([AddAnn],SourceText),((SourceText,FastString),(Int,Int),(Int,Int))) }
2263       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
2264                                       { sLL $1 $> $ (([mo $1,mj AnnVal $2
2265                                               ,mj AnnVal $3,mj AnnColon $4
2266                                               ,mj AnnVal $5,mj AnnMinus $6
2267                                               ,mj AnnVal $7,mj AnnColon $8
2268                                               ,mj AnnVal $9,mc $10],
2269                                                 getGENERATED_PRAGs $1)
2270                                               ,((getSTRINGs $2,getSTRING $2)
2271                                                ,( fromInteger $ getINTEGER $3
2272                                                 , fromInteger $ getINTEGER $5
2273                                                 )
2274                                                ,( fromInteger $ getINTEGER $7
2275                                                 , fromInteger $ getINTEGER $9
2276                                                 )
2277                                                ))
2278                                          }
2279
2280 fexp    :: { LHsExpr RdrName }
2281         : fexp aexp                             { sLL $1 $> $ HsApp $1 $2 }
2282         | 'static' aexp                         {% ams (sLL $1 $> $ HsStatic $2)
2283                                                        [mj AnnStatic $1] }
2284         | aexp                                  { $1 }
2285
2286 aexp    :: { LHsExpr RdrName }
2287         : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
2288         | '~' aexp              {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
2289         | aexp1                 { $1 }
2290
2291 aexp1   :: { LHsExpr RdrName }
2292         : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
2293                                                                    (snd $3)
2294                                      ; _ <- ams (sLL $1 $> ()) (moc $2:mcc $4:(fst $3))
2295                                      ; checkRecordSyntax (sLL $1 $> r) }}
2296         | aexp2                { $1 }
2297
2298 aexp2   :: { LHsExpr RdrName }
2299         : qvar                          { sL1 $1 (HsVar   $! unLoc $1) }
2300         | qcon                          { sL1 $1 (HsVar   $! unLoc $1) }
2301         | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
2302         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
2303 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
2304 -- into HsOverLit when -foverloaded-strings is on.
2305 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
2306 --                                       (getSTRING $1) placeHolderType) }
2307         | INTEGER   { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGERs $1)
2308                                          (getINTEGER $1) placeHolderType) }
2309         | RATIONAL  { sL (getLoc $1) (HsOverLit $! mkHsFractional
2310                                           (getRATIONAL $1) placeHolderType) }
2311
2312         -- N.B.: sections get parsed by these next two productions.
2313         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
2314         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
2315         -- but the less cluttered version fell out of having texps.
2316         | '(' texp ')'                  {% ams (sLL $1 $> (HsPar $2)) [mop $1,mcp $3] }
2317         | '(' tup_exprs ')'             {% ams (sLL $1 $> (ExplicitTuple $2 Boxed))
2318                                                [mop $1,mcp $3] }
2319
2320         | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple [L (gl $2)
2321                                                          (Present $2)] Unboxed))
2322                                                [mo $1,mc $3] }
2323         | '(#' tup_exprs '#)'           {% ams (sLL $1 $> (ExplicitTuple $2 Unboxed))
2324                                                [mo $1,mc $3] }
2325
2326         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
2327         | '[:' parr ':]'    {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
2328         | '_'               { sL1 $1 EWildPat }
2329
2330         -- Template Haskell Extension
2331         | splice_exp            { $1 }
2332
2333         | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2334         | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
2335         | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2336         | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
2337         | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] }
2338         | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]}
2339         | '[t|' ctype '|]'    {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
2340         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
2341                                       ams (sLL $1 $> $ HsBracket (PatBr p))
2342                                           [mo $1,mc $3] }
2343         | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
2344                                       (mo $1:mc $3:fst $2) }
2345         | quasiquote          { sL1 $1 (HsSpliceE (unLoc $1)) }
2346
2347         -- arrow notation extension
2348         | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm $2
2349                                                            Nothing (reverse $3))
2350                                           [mo $1,mc $4] }
2351
2352 splice_exp :: { LHsExpr RdrName }
2353         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkHsSpliceE
2354                                         (sL1 $1 $ HsVar (mkUnqual varName
2355                                                         (getTH_ID_SPLICE $1))))
2356                                        [mj AnnThIdSplice $1] }
2357         | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE $2)
2358                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
2359         | TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkHsSpliceTE
2360                                         (sL1 $1 $ HsVar (mkUnqual varName
2361                                                      (getTH_ID_TY_SPLICE $1))))
2362                                        [mj AnnThIdTySplice $1] }
2363         | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE $2)
2364                                        [mj AnnOpenPTE $1,mj AnnCloseP $3] }
2365
2366 cmdargs :: { [LHsCmdTop RdrName] }
2367         : cmdargs acmd                  { $2 : $1 }
2368         | {- empty -}                   { [] }
2369
2370 acmd    :: { LHsCmdTop RdrName }
2371         : aexp2                 {% checkCommand $1 >>= \ cmd ->
2372                                     return (sL1 $1 $ HsCmdTop cmd
2373                                            placeHolderType placeHolderType []) }
2374
2375 cvtopbody :: { ([AddAnn],[LHsDecl RdrName]) }
2376         :  '{'            cvtopdecls0 '}'      { ([mj AnnOpenC $1
2377                                                   ,mj AnnCloseC $3],$2) }
2378         |      vocurly    cvtopdecls0 close    { ([],$2) }
2379
2380 cvtopdecls0 :: { [LHsDecl RdrName] }
2381         : {- empty -}           { [] }
2382         | cvtopdecls            { $1 }
2383
2384 -----------------------------------------------------------------------------
2385 -- Tuple expressions
2386
2387 -- "texp" is short for tuple expressions:
2388 -- things that can appear unparenthesized as long as they're
2389 -- inside parens or delimitted by commas
2390 texp :: { LHsExpr RdrName }
2391         : exp                           { $1 }
2392
2393         -- Note [Parsing sections]
2394         -- ~~~~~~~~~~~~~~~~~~~~~~~
2395         -- We include left and right sections here, which isn't
2396         -- technically right according to the Haskell standard.
2397         -- For example (3 +, True) isn't legal.
2398         -- However, we want to parse bang patterns like
2399         --      (!x, !y)
2400         -- and it's convenient to do so here as a section
2401         -- Then when converting expr to pattern we unravel it again
2402         -- Meanwhile, the renamer checks that real sections appear
2403         -- inside parens.
2404         | infixexp qop        { sLL $1 $> $ SectionL $1 $2 }
2405         | qopm infixexp       { sLL $1 $> $ SectionR $1 $2 }
2406
2407        -- View patterns get parenthesized above
2408         | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] }
2409
2410 -- Always at least one comma
2411 tup_exprs :: { [LHsTupArg RdrName] }
2412            : texp commas_tup_tail
2413                           {% do { addAnnotation (gl $1) AnnComma (fst $2)
2414                                 ; return ((sL1 $1 (Present $1)) : snd $2) } }
2415
2416            | commas tup_tail
2417                 {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (fst $1)
2418                       ; return
2419                            (map (\l -> L l missingTupArg) (fst $1) ++ $2) } }
2420
2421 -- Always starts with commas; always follows an expr
2422 commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) }
2423 commas_tup_tail : commas tup_tail
2424        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
2425              ; return (
2426             (head $ fst $1
2427             ,(map (\l -> L l missingTupArg) (tail $ fst $1)) ++ $2)) } }
2428
2429 -- Always follows a comma
2430 tup_tail :: { [LHsTupArg RdrName] }
2431           : texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
2432                                     return ((L (gl $1) (Present $1)) : snd $2) }
2433           | texp                 { [L (gl $1) (Present $1)] }
2434           | {- empty -}          { [noLoc missingTupArg] }
2435
2436 -----------------------------------------------------------------------------
2437 -- List expressions
2438
2439 -- The rules below are little bit contorted to keep lexps left-recursive while
2440 -- avoiding another shift/reduce-conflict.
2441 list :: { ([AddAnn],HsExpr RdrName) }
2442         : texp    { ([],ExplicitList placeHolderType Nothing [$1]) }
2443         | lexps   { ([],ExplicitList placeHolderType Nothing
2444                                                    (reverse (unLoc $1))) }
2445         | texp '..'             { ([mj AnnDotdot $2],
2446                                       ArithSeq noPostTcExpr Nothing (From $1)) }
2447         | texp ',' exp '..'     { ([mj AnnComma $2,mj AnnDotdot $4],
2448                                   ArithSeq noPostTcExpr Nothing
2449                                                              (FromThen $1 $3)) }
2450         | texp '..' exp         { ([mj AnnDotdot $2],
2451                                    ArithSeq noPostTcExpr Nothing
2452                                                                (FromTo $1 $3)) }
2453         | texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
2454                                     ArithSeq noPostTcExpr Nothing
2455                                                 (FromThenTo $1 $3 $5)) }
2456         | texp '|' flattenedpquals
2457              {% checkMonadComp >>= \ ctxt ->
2458                 return ([mj AnnVbar $2],
2459                         mkHsComp ctxt (unLoc $3) $1) }
2460
2461 lexps :: { Located [LHsExpr RdrName] }
2462         : lexps ',' texp          {% addAnnotation (gl $ head $ unLoc $1)
2463                                                             AnnComma (gl $2) >>
2464                                       return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
2465         | texp ',' texp            {% addAnnotation (gl $1) AnnComma (gl $2) >>
2466                                       return (sLL $1 $> [$3,$1]) }
2467
2468 -----------------------------------------------------------------------------
2469 -- List Comprehensions
2470
2471 flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2472     : pquals   { case (unLoc $1) of
2473                     [qs] -> sL1 $1 qs
2474                     -- We just had one thing in our "parallel" list so
2475                     -- we simply return that thing directly
2476
2477                     qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock qs [] noSyntaxExpr |
2478                                             qs <- qss]
2479                                             noSyntaxExpr noSyntaxExpr]
2480                     -- We actually found some actual parallel lists so
2481                     -- we wrap them into as a ParStmt
2482                 }
2483
2484 pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] }
2485     : squals '|' pquals
2486                      {% addAnnotation (gl $ head $ unLoc $1) AnnVbar (gl $2) >>
2487                         return (sLL $1 $> (reverse (unLoc $1) : unLoc $3)) }
2488     | squals         { L (getLoc $1) [reverse (unLoc $1)] }
2489
2490 squals :: { Located [LStmt RdrName (LHsExpr RdrName)] }   -- In reverse order, because the last
2491                                         -- one can "grab" the earlier ones
2492     : squals ',' transformqual
2493              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2494                 ams (sLL $1 $> ()) (fst $ unLoc $3) >>
2495                 return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) }
2496     | squals ',' qual
2497              {% addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >>
2498                 return (sLL $1 $> ($3 : unLoc $1)) }
2499     | transformqual        {% ams $1 (fst $ unLoc $1) >>
2500                               return (sLL $1 $> [L (getLoc $1) ((snd $ unLoc $1) [])]) }
2501     | qual                                { sL1 $1 [$1] }
2502 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
2503 --  | '{|' pquals '|}'                       { sL1 $1 [$2] }
2504
2505 -- It is possible to enable bracketing (associating) qualifier lists
2506 -- by uncommenting the lines with {| |} above. Due to a lack of
2507 -- consensus on the syntax, this feature is not being used until we
2508 -- get user demand.
2509
2510 transformqual :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)] -> Stmt RdrName (LHsExpr RdrName)) }
2511                         -- Function is applied to a list of stmts *in order*
2512     : 'then' exp               { sLL $1 $> ([mj AnnThen $1], \ss -> (mkTransformStmt ss $2)) }
2513     | 'then' exp 'by' exp      { sLL $1 $> ([mj AnnThen $1,mj AnnBy  $3],\ss -> (mkTransformByStmt ss $2 $4)) }
2514     | 'then' 'group' 'using' exp
2515              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3], \ss -> (mkGroupUsingStmt ss $4)) }
2516
2517     | 'then' 'group' 'by' exp 'using' exp
2518              { sLL $1 $> ([mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5], \ss -> (mkGroupByUsingStmt ss $4 $6)) }
2519
2520 -- Note that 'group' is a special_id, which means that you can enable
2521 -- TransformListComp while still using Data.List.group. However, this
2522 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
2523 -- in by choosing the "group by" variant, which is what we want.
2524
2525 -----------------------------------------------------------------------------
2526 -- Parallel array expressions
2527
2528 -- The rules below are little bit contorted; see the list case for details.
2529 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
2530 -- Moreover, we allow explicit arrays with no element (represented by the nil
2531 -- constructor in the list case).
2532
2533 parr :: { ([AddAnn],HsExpr RdrName) }
2534         :                      { ([],ExplicitPArr placeHolderType []) }
2535         | texp                 { ([],ExplicitPArr placeHolderType [$1]) }
2536         | lexps                { ([],ExplicitPArr placeHolderType
2537                                                           (reverse (unLoc $1))) }
2538         | texp '..' exp        { ([mj AnnDotdot $2]
2539                                  ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
2540         | texp ',' exp '..' exp
2541                         { ([mj AnnComma $2,mj AnnDotdot $4]
2542                           ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
2543         | texp '|' flattenedpquals
2544                         { ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
2545
2546 -- We are reusing `lexps' and `flattenedpquals' from the list case.
2547
2548 -----------------------------------------------------------------------------
2549 -- Guards
2550
2551 guardquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2552     : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
2553
2554 guardquals1 :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2555     : guardquals1 ',' qual  {% addAnnotation (gl $ head $ unLoc $1) AnnComma
2556                                              (gl $2) >>
2557                                return (sLL $1 $> ($3 : unLoc $1)) }
2558     | qual                  { sL1 $1 [$1] }
2559
2560 -----------------------------------------------------------------------------
2561 -- Case alternatives
2562
2563 altslist :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2564         : '{'            alts '}'  { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2565                                                ,(reverse (snd $ unLoc $2))) }
2566         |     vocurly    alts  close { L (getLoc $2) (fst $ unLoc $2
2567                                         ,(reverse (snd $ unLoc $2))) }
2568         | '{'                 '}'    { noLoc ([moc $1,mcc $2],[]) }
2569         |     vocurly          close { noLoc ([],[]) }
2570
2571 alts    :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2572         : alts1                    { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) }
2573         | ';' alts                 { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2))
2574                                                ,snd $ unLoc $2) }
2575
2576 alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2577         : alts1 ';' alt         {% if null (snd $ unLoc $1)
2578                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2579                                                   ,[$3]))
2580                                      else (ams (head $ snd $ unLoc $1)
2581                                                (mj AnnSemi $2:(fst $ unLoc $1))
2582                                            >> return (sLL $1 $> ([],$3 : (snd $ unLoc $1))) ) }
2583         | alts1 ';'             {% if null (snd $ unLoc $1)
2584                                      then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2585                                                   ,snd $ unLoc $1))
2586                                      else (ams (head $ snd $ unLoc $1)
2587                                                (mj AnnSemi $2:(fst $ unLoc $1))
2588                                            >> return (sLL $1 $> ([],snd $ unLoc $1))) }
2589         | alt                   { sL1 $1 ([],[$1]) }
2590
2591 alt     :: { LMatch RdrName (LHsExpr RdrName) }
2592         : pat opt_sig alt_rhs      {%ams (sLL $1 $> (Match Nothing [$1] (snd $2)
2593                                                               (snd $ unLoc $3)))
2594                                          ((fst $2) ++ (fst $ unLoc $3))}
2595
2596 alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
2597         : ralt wherebinds           { sLL $1 $> (fst $ unLoc $2,
2598                                             GRHSs (unLoc $1) (snd $ unLoc $2)) }
2599
2600 ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2601         : '->' exp            {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
2602                                      [mj AnnRarrow $1] }
2603         | gdpats              { sL1 $1 (reverse (unLoc $1)) }
2604
2605 gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2606         : gdpats gdpat                  { sLL $1 $> ($2 : unLoc $1) }
2607         | gdpat                         { sL1 $1 [$1] }
2608
2609 -- optional semi-colons between the guards of a MultiWayIf, because we use
2610 -- layout here, but we don't need (or want) the semicolon as a separator (#7783).
2611 gdpatssemi :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2612         : gdpatssemi gdpat optSemi  {% ams (sL (comb2 $1 $2) ($2 : unLoc $1))
2613                                            (map (\l -> mj AnnSemi l) $ fst $3) }
2614         | gdpat optSemi             {% ams (sL1 $1 [$1])
2615                                            (map (\l -> mj AnnSemi l) $ fst $2) }
2616
2617 -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
2618 -- generate the open brace in addition to the vertical bar in the lexer, and
2619 -- we don't need it.
2620 ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
2621          : '{' gdpatssemi '}'             { sLL $1 $> ([moc $1,mcc $3],unLoc $2)  }
2622          |     gdpatssemi close           { sL1 $1 ([],unLoc $1) }
2623
2624 gdpat   :: { LGRHS RdrName (LHsExpr RdrName) }
2625         : '|' guardquals '->' exp
2626                                   {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2627                                          [mj AnnVbar $1,mj AnnRarrow $3] }
2628
2629 -- 'pat' recognises a pattern, including one with a bang at the top
2630 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
2631 -- Bangs inside are parsed as infix operator applications, so that
2632 -- we parse them right when bang-patterns are off
2633 pat     :: { LPat RdrName }
2634 pat     :  exp          {% checkPattern empty $1 }
2635         | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR
2636                                                      (sL1 $1 (HsVar bang_RDR)) $2)))
2637                                 [mj AnnBang $1] }
2638
2639 bindpat :: { LPat RdrName }
2640 bindpat :  exp            {% checkPattern
2641                                 (text "Possibly caused by a missing 'do'?") $1 }
2642         | '!' aexp        {% amms (checkPattern
2643                                      (text "Possibly caused by a missing 'do'?")
2644                                      (sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2)))
2645                                   [mj AnnBang $1] }
2646
2647 apat   :: { LPat RdrName }
2648 apat    : aexp                  {% checkPattern empty $1 }
2649         | '!' aexp              {% amms (checkPattern empty
2650                                             (sLL $1 $> (SectionR
2651                                                 (sL1 $1 (HsVar bang_RDR)) $2)))
2652                                         [mj AnnBang $1] }
2653
2654 apats  :: { [LPat RdrName] }
2655         : apat apats            { $1 : $2 }
2656         | {- empty -}           { [] }
2657
2658 -----------------------------------------------------------------------------
2659 -- Statement sequences
2660
2661 stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2662         : '{'           stmts '}'       { sLL $1 $> ((moc $1:mcc $3:(fst $ unLoc $2))
2663                                              ,(reverse $ snd $ unLoc $2)) } -- AZ:performance of reverse?
2664         |     vocurly   stmts close     { L (gl $2) (fst $ unLoc $2
2665                                                     ,reverse $ snd $ unLoc $2) }
2666
2667 --      do { ;; s ; s ; ; s ;; }
2668 -- The last Stmt should be an expression, but that's hard to enforce
2669 -- here, because we need too much lookahead if we see do { e ; }
2670 -- So we use BodyStmts throughout, and switch the last one over
2671 -- in ParseUtils.checkDo instead
2672 -- AZ: TODO check that we can retrieve multiple semis.
2673
2674 stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2675         : stmts ';' stmt  {% if null (snd $ unLoc $1)
2676                               then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1)
2677                                                      ,$3 : (snd $ unLoc $1)))
2678                               else do
2679                                { ams (head $ snd $ unLoc $1) [mj AnnSemi $2]
2680                                ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(snd $ unLoc $1)) }}
2681
2682         | stmts ';'     {% if null (snd $ unLoc $1)
2683                              then return (sLL $1 $> (mj AnnSemi $2:(fst $ unLoc $1),snd $ unLoc $1))
2684                              else do
2685                                { ams (head $ snd $ unLoc $1)
2686                                                [mj AnnSemi $2]
2687                                ; return $1 } }
2688         | stmt                   { sL1 $1 ([],[$1]) }
2689         | {- empty -}            { noLoc ([],[]) }
2690
2691
2692 -- For typing stmts at the GHCi prompt, where
2693 -- the input may consist of just comments.
2694 maybe_stmt :: { Maybe (LStmt RdrName (LHsExpr RdrName)) }
2695         : stmt                          { Just $1 }
2696         | {- nothing -}                 { Nothing }
2697
2698 stmt  :: { LStmt RdrName (LHsExpr RdrName) }
2699         : qual                          { $1 }
2700         | 'rec' stmtlist                {% ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
2701                                                (mj AnnRec $1:(fst $ unLoc $2)) }
2702
2703 qual  :: { LStmt RdrName (LHsExpr RdrName) }
2704     : bindpat '<-' exp                  {% ams (sLL $1 $> $ mkBindStmt $1 $3)
2705                                                [mj AnnLarrow $2] }
2706     | exp                               { sL1 $1 $ mkBodyStmt $1 }
2707     | 'let' binds                       {% ams (sLL $1 $>$ LetStmt (snd $ unLoc $2))
2708                                                (mj AnnLet $1:(fst $ unLoc $2)) }
2709
2710 -----------------------------------------------------------------------------
2711 -- Record Field Update/Construction
2712
2713 fbinds  :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2714         : fbinds1                       { $1 }
2715         | {- empty -}                   { ([],([], False)) }
2716
2717 fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2718         : fbind ',' fbinds1
2719                 {% addAnnotation (gl $1) AnnComma (gl $2) >>
2720                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
2721         | fbind                         { ([],([$1], False)) }
2722         | '..'                          { ([mj AnnDotdot $1],([],   True)) }
2723
2724 fbind   :: { LHsRecField RdrName (LHsExpr RdrName) }
2725         : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField $1 $3             False)
2726                                 [mj AnnEqual $2] }
2727                         -- RHS is a 'texp', allowing view patterns (Trac #6038)
2728                         -- and, incidentaly, sections.  Eg
2729                         -- f (R { x = show -> s }) = ...
2730
2731         | qvar          { sLL $1 $> $ HsRecField $1 placeHolderPunRhs True }
2732                         -- In the punning case, use a place-holder
2733                         -- The renamer fills in the final value
2734
2735 -----------------------------------------------------------------------------
2736 -- Implicit Parameter Bindings
2737
2738 dbinds  :: { Located [LIPBind RdrName] }
2739         : dbinds ';' dbind
2740                       {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2741                          return (let { this = $3; rest = unLoc $1 }
2742                               in rest `seq` this `seq` sLL $1 $> (this : rest)) }
2743         | dbinds ';'  {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2744                          return (sLL $1 $> (unLoc $1)) }
2745         | dbind                        { let this = $1 in this `seq` sL1 $1 [this] }
2746 --      | {- empty -}                  { [] }
2747
2748 dbind   :: { LIPBind RdrName }
2749 dbind   : ipvar '=' exp                {% ams (sLL $1 $> (IPBind (Left $1) $3))
2750                                               [mj AnnEqual $2] }
2751
2752 ipvar   :: { Located HsIPName }
2753         : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
2754
2755 -----------------------------------------------------------------------------
2756 -- Warnings and deprecations
2757
2758 name_boolformula_opt :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2759         : name_boolformula          { $1 }
2760         | {- empty -}               { ([],mkTrue) }
2761
2762 name_boolformula :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2763         : name_boolformula_and                      { $1 }
2764         | name_boolformula_and '|' name_boolformula
2765                                              { ((mj AnnVbar $2:fst $1)++(fst $3)
2766                                                 ,Or [snd $1,snd $3]) }
2767
2768 name_boolformula_and :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2769         : name_boolformula_atom                             { $1 }
2770         | name_boolformula_atom ',' name_boolformula_and
2771                   { ((mj AnnComma $2:fst $1)++(fst $3), And [snd $1,snd $3]) }
2772
2773 name_boolformula_atom :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2774         : '(' name_boolformula ')'  { ((mop $1:mcp $3:(fst $2)),snd $2) }
2775         | name_var                  { ([],Var $1) }
2776
2777 namelist :: { Located [Located RdrName] }
2778 namelist : name_var              { sL1 $1 [$1] }
2779          | name_var ',' namelist {% addAnnotation (gl $1) AnnComma (gl $2) >>
2780                                     return (sLL $1 $> ($1 : unLoc $3)) }
2781
2782 name_var :: { Located RdrName }
2783 name_var : var { $1 }
2784          | con { $1 }
2785
2786 -----------------------------------------
2787 -- Data constructors
2788 -- There are two different productions here as lifted list constructors
2789 -- are parsed differently.
2790
2791 qcon_nowiredlist :: { Located RdrName }
2792         : gen_qcon                     { $1 }
2793         | sysdcon_nolist               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2794
2795 qcon :: { Located RdrName }
2796   : gen_qcon              { $1}
2797   | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2798
2799 gen_qcon :: { Located RdrName }
2800   : qconid                { $1 }
2801   | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2))
2802                                    [mop $1,mj AnnVal $2,mcp $3] }
2803
2804 -- The case of '[:' ':]' is part of the production `parr'
2805
2806 con     :: { Located RdrName }
2807         : conid                 { $1 }
2808         | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2))
2809                                        [mop $1,mj AnnVal $2,mcp $3] }
2810         | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2811
2812 con_list :: { Located [Located RdrName] }
2813 con_list : con                  { sL1 $1 [$1] }
2814          | con ',' con_list     {% addAnnotation (gl $1) AnnComma (gl $2) >>
2815                                    return (sLL $1 $> ($1 : unLoc $3)) }
2816
2817 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
2818         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
2819         | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
2820                                        (mop $1:mcp $3:(mcommas (fst $2))) }
2821         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
2822         | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
2823                                        (mo $1:mc $3:(mcommas (fst $2))) }
2824
2825 sysdcon :: { Located DataCon }
2826         : sysdcon_nolist                 { $1 }
2827         | '[' ']'               {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] }
2828
2829 conop :: { Located RdrName }
2830         : consym                { $1 }
2831         | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2))
2832                                        [mj AnnBackquote $1,mj AnnVal $2
2833                                        ,mj AnnBackquote $3] }
2834
2835 qconop :: { Located RdrName }
2836         : qconsym               { $1 }
2837         | '`' qconid '`'        {% ams (sLL $1 $> (unLoc $2))
2838                                        [mj AnnBackquote $1,mj AnnVal $2
2839                                        ,mj AnnBackquote $3] }
2840
2841 ----------------------------------------------------------------------------
2842 -- Type constructors
2843
2844
2845 -- See Note [Unit tuples] in HsTypes for the distinction
2846 -- between gtycon and ntgtycon
2847 gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
2848         : ntgtycon                     { $1 }
2849         | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)
2850                                               [mop $1,mcp $2] }
2851         | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)
2852                                               [mo $1,mc $2] }
2853
2854 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
2855         : oqtycon               { $1 }
2856         | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
2857                                                         (snd $2 + 1)))
2858                                        (mop $1:mcp $3:(mcommas (fst $2))) }
2859         | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
2860                                                         (snd $2 + 1)))
2861                                        (mo $1:mc $3:(mcommas (fst $2))) }
2862         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
2863                                        [mop $1,mj AnnRarrow $2,mcp $3] }
2864         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
2865         | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
2866         | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
2867                                         [mop $1,mj AnnTildehsh $2,mcp $3] }
2868
2869 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
2870                                 -- These can appear in export lists
2871         : qtycon                        { $1 }
2872         | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2))
2873                                                [mop $1,mj AnnVal $2,mcp $3] }
2874         | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)
2875                                                [mop $1,mj AnnTilde $2,mcp $3] }
2876
2877 qtyconop :: { Located RdrName } -- Qualified or unqualified
2878         : qtyconsym                     { $1 }
2879         | '`' qtycon '`'                {% ams (sLL $1 $> (unLoc $2))
2880                                                [mj AnnBackquote $1,mj AnnVal $2
2881                                                ,mj AnnBackquote $3] }
2882
2883 qtycon :: { Located RdrName }   -- Qualified or unqualified
2884         : QCONID            { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
2885         | tycon             { $1 }
2886
2887 tycon   :: { Located RdrName }  -- Unqualified
2888         : CONID                   { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
2889
2890 qtyconsym :: { Located RdrName }
2891         : QCONSYM            { sL1 $1 $! mkQual tcClsName (getQCONSYM $1) }
2892         | QVARSYM            { sL1 $1 $! mkQual tcClsName (getQVARSYM $1) }
2893         | tyconsym           { $1 }
2894
2895 -- Does not include "!", because that is used for strictness marks
2896 --               or ".", because that separates the quantified type vars from the rest
2897 tyconsym :: { Located RdrName }
2898         : CONSYM                { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
2899         | VARSYM                { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
2900         | ':'                   { sL1 $1 $! consDataCon_RDR }
2901         | '*'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "*") }
2902         | '-'                   { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
2903
2904
2905 -----------------------------------------------------------------------------
2906 -- Operators
2907
2908 op      :: { Located RdrName }   -- used in infix decls
2909         : varop                 { $1 }
2910         | conop                 { $1 }
2911
2912 varop   :: { Located RdrName }
2913         : varsym                { $1 }
2914         | '`' varid '`'         {% ams (sLL $1 $> (unLoc $2))
2915                                        [mj AnnBackquote $1,mj AnnVal $2
2916                                        ,mj AnnBackquote $3] }
2917
2918 qop     :: { LHsExpr RdrName }   -- used in sections
2919         : qvarop                { sL1 $1 $ HsVar (unLoc $1) }
2920         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2921
2922 qopm    :: { LHsExpr RdrName }   -- used in sections
2923         : qvaropm               { sL1 $1 $ HsVar (unLoc $1) }
2924         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2925
2926 qvarop :: { Located RdrName }
2927         : qvarsym               { $1 }
2928         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
2929                                        [mj AnnBackquote $1,mj AnnVal $2
2930                                        ,mj AnnBackquote $3] }
2931
2932 qvaropm :: { Located RdrName }
2933         : qvarsym_no_minus      { $1 }
2934         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2))
2935                                        [mj AnnBackquote $1,mj AnnVal $2
2936                                        ,mj AnnBackquote $3] }
2937
2938 -----------------------------------------------------------------------------
2939 -- Type variables
2940
2941 tyvar   :: { Located RdrName }
2942 tyvar   : tyvarid               { $1 }
2943
2944 tyvarop :: { Located RdrName }
2945 tyvarop : '`' tyvarid '`'       {% ams (sLL $1 $> (unLoc $2))
2946                                        [mj AnnBackquote $1,mj AnnVal $2
2947                                        ,mj AnnBackquote $3] }
2948         | '.'                   {% parseErrorSDoc (getLoc $1)
2949                                       (vcat [ptext (sLit "Illegal symbol '.' in type"),
2950                                              ptext (sLit "Perhaps you intended to use RankNTypes or a similar language"),
2951                                              ptext (sLit "extension to enable explicit-forall syntax: forall <tvs>. <type>")])
2952                                 }
2953
2954 tyvarid :: { Located RdrName }
2955         : VARID            { sL1 $1 $! mkUnqual tvName (getVARID $1) }
2956         | special_id       { sL1 $1 $! mkUnqual tvName (unLoc $1) }
2957         | 'unsafe'         { sL1 $1 $! mkUnqual tvName (fsLit "unsafe") }
2958         | 'safe'           { sL1 $1 $! mkUnqual tvName (fsLit "safe") }
2959         | 'interruptible'  { sL1 $1 $! mkUnqual tvName (fsLit "interruptible") }
2960
2961 -----------------------------------------------------------------------------
2962 -- Variables
2963
2964 var     :: { Located RdrName }
2965         : varid                 { $1 }
2966         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
2967                                        [mop $1,mj AnnVal $2,mcp $3] }
2968
2969 qvar    :: { Located RdrName }
2970         : qvarid                { $1 }
2971         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2))
2972                                        [mop $1,mj AnnVal $2,mcp $3] }
2973         | '(' qvarsym1 ')'      {% ams (sLL $1 $> (unLoc $2))
2974                                        [mop $1,mj AnnVal $2,mcp $3] }
2975 -- We've inlined qvarsym here so that the decision about
2976 -- whether it's a qvar or a var can be postponed until
2977 -- *after* we see the close paren.
2978
2979 qvarid :: { Located RdrName }
2980         : varid               { $1 }
2981         | QVARID              { sL1 $1 $! mkQual varName (getQVARID $1) }
2982
2983 -- Note that 'role' and 'family' get lexed separately regardless of
2984 -- the use of extensions. However, because they are listed here, this
2985 -- is OK and they can be used as normal varids.
2986 varid :: { Located RdrName }
2987         : VARID            { sL1 $1 $! mkUnqual varName (getVARID $1) }
2988         | special_id       { sL1 $1 $! mkUnqual varName (unLoc $1) }
2989         | 'unsafe'         { sL1 $1 $! mkUnqual varName (fsLit "unsafe") }
2990         | 'safe'           { sL1 $1 $! mkUnqual varName (fsLit "safe") }
2991         | 'interruptible'  { sL1 $1 $! mkUnqual varName (fsLit "interruptible")}
2992         | 'forall'         { sL1 $1 $! mkUnqual varName (fsLit "forall") }
2993         | 'family'         { sL1 $1 $! mkUnqual varName (fsLit "family") }
2994         | 'role'           { sL1 $1 $! mkUnqual varName (fsLit "role") }
2995
2996 qvarsym :: { Located RdrName }
2997         : varsym                { $1 }
2998         | qvarsym1              { $1 }
2999
3000 qvarsym_no_minus :: { Located RdrName }
3001         : varsym_no_minus       { $1 }
3002         | qvarsym1              { $1 }
3003
3004 qvarsym1 :: { Located RdrName }
3005 qvarsym1 : QVARSYM              { sL1 $1 $ mkQual varName (getQVARSYM $1) }
3006
3007 varsym :: { Located RdrName }
3008         : varsym_no_minus       { $1 }
3009         | '-'                   { sL1 $1 $ mkUnqual varName (fsLit "-") }
3010
3011 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
3012         : VARSYM               { sL1 $1 $ mkUnqual varName (getVARSYM $1) }
3013         | special_sym          { sL1 $1 $ mkUnqual varName (unLoc $1) }
3014
3015
3016 -- These special_ids are treated as keywords in various places,
3017 -- but as ordinary ids elsewhere.   'special_id' collects all these
3018 -- except 'unsafe', 'interruptible', 'forall', 'family', and 'role',
3019 -- whose treatment differs depending on context
3020 special_id :: { Located FastString }
3021 special_id
3022         : 'as'                  { sL1 $1 (fsLit "as") }
3023         | 'qualified'           { sL1 $1 (fsLit "qualified") }
3024         | 'hiding'              { sL1 $1 (fsLit "hiding") }
3025         | 'export'              { sL1 $1 (fsLit "export") }
3026         | 'label'               { sL1 $1 (fsLit "label")  }
3027         | 'dynamic'             { sL1 $1 (fsLit "dynamic") }
3028         | 'stdcall'             { sL1 $1 (fsLit "stdcall") }
3029         | 'ccall'               { sL1 $1 (fsLit "ccall") }
3030         | 'capi'                { sL1 $1 (fsLit "capi") }
3031         | 'prim'                { sL1 $1 (fsLit "prim") }
3032         | 'javascript'          { sL1 $1 (fsLit "javascript") }
3033         | 'group'               { sL1 $1 (fsLit "group") }
3034
3035 special_sym :: { Located FastString }
3036 special_sym : '!'       {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
3037             | '.'       { sL1 $1 (fsLit ".") }
3038             | '*'       { sL1 $1 (fsLit "*") }
3039
3040 -----------------------------------------------------------------------------
3041 -- Data constructors
3042
3043 qconid :: { Located RdrName }   -- Qualified or unqualified
3044         : conid              { $1 }
3045         | QCONID             { sL1 $1 $! mkQual dataName (getQCONID $1) }
3046
3047 conid   :: { Located RdrName }
3048         : CONID                { sL1 $1 $ mkUnqual dataName (getCONID $1) }
3049
3050 qconsym :: { Located RdrName }  -- Qualified or unqualified
3051         : consym               { $1 }
3052         | QCONSYM              { sL1 $1 $ mkQual dataName (getQCONSYM $1) }
3053
3054 consym :: { Located RdrName }
3055         : CONSYM              { sL1 $1 $ mkUnqual dataName (getCONSYM $1) }
3056
3057         -- ':' means only list cons
3058         | ':'                { sL1 $1 $ consDataCon_RDR }
3059
3060
3061 -----------------------------------------------------------------------------
3062 -- Literals
3063
3064 literal :: { Located HsLit }
3065         : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }
3066         | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)
3067                                                    $ getSTRING $1 }
3068         | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)
3069                                                    $ getPRIMINTEGER $1 }
3070         | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)
3071                                                    $ getPRIMWORD $1 }
3072         | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)
3073                                                    $ getPRIMCHAR $1 }
3074         | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
3075                                                    $ getPRIMSTRING $1 }
3076         | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
3077         | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
3078
3079 -----------------------------------------------------------------------------
3080 -- Layout
3081
3082 close :: { () }
3083         : vccurly               { () } -- context popped in lexer.
3084         | error                 {% popContext }
3085
3086 -----------------------------------------------------------------------------
3087 -- Miscellaneous (mostly renamings)
3088
3089 modid   :: { Located ModuleName }
3090         : CONID                 { sL1 $1 $ mkModuleNameFS (getCONID $1) }
3091         | QCONID                { sL1 $1 $ let (mod,c) = getQCONID $1 in
3092                                   mkModuleNameFS
3093                                    (mkFastString
3094                                      (unpackFS mod ++ '.':unpackFS c))
3095                                 }
3096
3097 commas :: { ([SrcSpan],Int) }   -- One or more commas
3098         : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }
3099         | ','                    { ([gl $1],1) }
3100
3101 -----------------------------------------------------------------------------
3102 -- Documentation comments
3103
3104 docnext :: { LHsDocString }
3105   : DOCNEXT {% return (sL1 $1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
3106
3107 docprev :: { LHsDocString }
3108   : DOCPREV {% return (sL1 $1 (HsDocString (mkFastString (getDOCPREV $1)))) }
3109
3110 docnamed :: { Located (String, HsDocString) }
3111   : DOCNAMED {%
3112       let string = getDOCNAMED $1
3113           (name, rest) = break isSpace string
3114       in return (sL1 $1 (name, HsDocString (mkFastString rest))) }
3115
3116 docsection :: { Located (Int, HsDocString) }
3117   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
3118         return (sL1 $1 (n, HsDocString (mkFastString doc))) }
3119
3120 moduleheader :: { Maybe LHsDocString }
3121         : DOCNEXT {% let string = getDOCNEXT $1 in
3122                      return (Just (sL1 $1 (HsDocString (mkFastString string)))) }
3123
3124 maybe_docprev :: { Maybe LHsDocString }
3125         : docprev                       { Just $1 }
3126         | {- empty -}                   { Nothing }
3127
3128 maybe_docnext :: { Maybe LHsDocString }
3129         : docnext                       { Just $1 }
3130         | {- empty -}                   { Nothing }
3131
3132 {
3133 happyError :: P a
3134 happyError = srcParseFail
3135
3136 getVARID        (L _ (ITvarid    x)) = x
3137 getCONID        (L _ (ITconid    x)) = x
3138 getVARSYM       (L _ (ITvarsym   x)) = x
3139 getCONSYM       (L _ (ITconsym   x)) = x
3140 getQVARID       (L _ (ITqvarid   x)) = x
3141 getQCONID       (L _ (ITqconid   x)) = x
3142 getQVARSYM      (L _ (ITqvarsym  x)) = x
3143 getQCONSYM      (L _ (ITqconsym  x)) = x
3144 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
3145 getCHAR         (L _ (ITchar   _ x)) = x
3146 getSTRING       (L _ (ITstring _ x)) = x
3147 getINTEGER      (L _ (ITinteger _ x)) = x
3148 getRATIONAL     (L _ (ITrational x)) = x
3149 getPRIMCHAR     (L _ (ITprimchar _ x)) = x
3150 getPRIMSTRING   (L _ (ITprimstring _ x)) = x
3151 getPRIMINTEGER  (L _ (ITprimint  _ x)) = x
3152 getPRIMWORD     (L _ (ITprimword _ x)) = x
3153 getPRIMFLOAT    (L _ (ITprimfloat x)) = x
3154 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
3155 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
3156 getTH_ID_TY_SPLICE (L _ (ITidTyEscape x)) = x
3157 getINLINE       (L _ (ITinline_prag _ inl conl)) = (inl,conl)
3158 getSPEC_INLINE  (L _ (ITspec_inline_prag _ True))  = (Inline,  FunLike)
3159 getSPEC_INLINE  (L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)
3160
3161 getDOCNEXT (L _ (ITdocCommentNext x)) = x
3162 getDOCPREV (L _ (ITdocCommentPrev x)) = x
3163 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
3164 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
3165
3166 getCHARs        (L _ (ITchar       src _)) = src
3167 getSTRINGs      (L _ (ITstring     src _)) = src
3168 getINTEGERs     (L _ (ITinteger    src _)) = src
3169 getPRIMCHARs    (L _ (ITprimchar   src _)) = src
3170 getPRIMSTRINGs  (L _ (ITprimstring src _)) = src
3171 getPRIMINTEGERs (L _ (ITprimint    src _)) = src
3172 getPRIMWORDs    (L _ (ITprimword   src _)) = src
3173
3174 -- See Note [Pragma source text] in BasicTypes for the following
3175 getINLINE_PRAGs       (L _ (ITinline_prag       src _ _)) = src
3176 getSPEC_PRAGs         (L _ (ITspec_prag         src))     = src
3177 getSPEC_INLINE_PRAGs  (L _ (ITspec_inline_prag  src _))   = src
3178 getSOURCE_PRAGs       (L _ (ITsource_prag       src)) = src
3179 getRULES_PRAGs        (L _ (ITrules_prag        src)) = src
3180 getWARNING_PRAGs      (L _ (ITwarning_prag      src)) = src
3181 getDEPRECATED_PRAGs   (L _ (ITdeprecated_prag   src)) = src
3182 getSCC_PRAGs          (L _ (ITscc_prag          src)) = src
3183 getGENERATED_PRAGs    (L _ (ITgenerated_prag    src)) = src
3184 getCORE_PRAGs         (L _ (ITcore_prag         src)) = src
3185 getUNPACK_PRAGs       (L _ (ITunpack_prag       src)) = src
3186 getNOUNPACK_PRAGs     (L _ (ITnounpack_prag     src)) = src
3187 getANN_PRAGs          (L _ (ITann_prag          src)) = src
3188 getVECT_PRAGs         (L _ (ITvect_prag         src)) = src
3189 getVECT_SCALAR_PRAGs  (L _ (ITvect_scalar_prag  src)) = src
3190 getNOVECT_PRAGs       (L _ (ITnovect_prag       src)) = src
3191 getMINIMAL_PRAGs      (L _ (ITminimal_prag      src)) = src
3192 getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src
3193 getOVERLAPPING_PRAGs  (L _ (IToverlapping_prag  src)) = src
3194 getOVERLAPS_PRAGs     (L _ (IToverlaps_prag     src)) = src
3195 getINCOHERENT_PRAGs   (L _ (ITincoherent_prag   src)) = src
3196 getCTYPEs             (L _ (ITctype             src)) = src
3197
3198
3199 getSCC :: Located Token -> P FastString
3200 getSCC lt = do let s = getSTRING lt
3201                    err = "Spaces are not allowed in SCCs"
3202                -- We probably actually want to be more restrictive than this
3203                if ' ' `elem` unpackFS s
3204                    then failSpanMsgP (getLoc lt) (text err)
3205                    else return s
3206
3207 -- Utilities for combining source spans
3208 comb2 :: Located a -> Located b -> SrcSpan
3209 comb2 a b = a `seq` b `seq` combineLocs a b
3210
3211 comb3 :: Located a -> Located b -> Located c -> SrcSpan
3212 comb3 a b c = a `seq` b `seq` c `seq`
3213     combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
3214
3215 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
3216 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
3217     (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
3218                 combineSrcSpans (getLoc c) (getLoc d))
3219
3220 -- strict&n