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