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