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