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