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