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