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