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