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