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