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