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