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