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