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