Fix panic on [t| _ |] (Trac #9879)
[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         | '[' ctype ',' comma_types1 ']'  {% ams (sLL $1 $> $ HsExplicitListTy
1487                                                      placeHolderKind ($2 : $4))
1488                                                  [mo $1, mj AnnComma $3,mc $5] }
1489         | INTEGER                     { sLL $1 $> $ HsTyLit $ HsNumTy $ getINTEGER $1 }
1490         | STRING                      { sLL $1 $> $ HsTyLit $ HsStrTy $ getSTRING  $1 }
1491         | '_'                         { sL1 $1 $ HsWildcardTy }
1492
1493 -- An inst_type is what occurs in the head of an instance decl
1494 --      e.g.  (Foo a, Gaz b) => Wibble a b
1495 -- It's kept as a single type, with a MonoDictTy at the right
1496 -- hand corner, for convenience.
1497 inst_type :: { LHsType RdrName }
1498         : sigtype                       { $1 }
1499
1500 inst_types1 :: { [LHsType RdrName] }
1501         : inst_type                     { [$1] }
1502
1503         | inst_type ',' inst_types1    {% addAnnotation (gl $1) AnnComma (gl $2)
1504                                           >> return ($1 : $3) }
1505
1506 comma_types0  :: { [LHsType RdrName] }
1507         : comma_types1                  { $1 }
1508         | {- empty -}                   { [] }
1509
1510 comma_types1    :: { [LHsType RdrName] }
1511         : ctype                        { [$1] }
1512         | ctype  ',' comma_types1      {% addAnnotation (gl $1) AnnComma (gl $2)
1513                                           >> return ($1 : $3) }
1514
1515 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1516          : tv_bndr tv_bndrs             { $1 : $2 }
1517          | {- empty -}                  { [] }
1518
1519 tv_bndr :: { LHsTyVarBndr RdrName }
1520         : tyvar                         { sL1 $1 (UserTyVar (unLoc $1)) }
1521         | '(' tyvar '::' kind ')'       {% ams (sLL $1 $>  (KindedTyVar (unLoc $2) $4))
1522                                                [mo $1,mj AnnDcolon $3
1523                                                ,mc $5] }
1524
1525 fds :: { Located [Located (FunDep RdrName)] }
1526         : {- empty -}                   { noLoc [] }
1527         | '|' fds1                      {% ams (sLL $1 $> (reverse (unLoc $2)))
1528                                                 [mj AnnVbar $1] }
1529
1530 fds1 :: { Located [Located (FunDep RdrName)] }
1531         : fds1 ',' fd                  {% addAnnotation (gl $3) AnnComma (gl $2)
1532                                           >> return (sLL $1 $> ($3 : unLoc $1)) }
1533         | fd                           { sL1 $1 [$1] }
1534
1535 fd :: { Located (FunDep RdrName) }
1536         : varids0 '->' varids0  {% ams (L (comb3 $1 $2 $3)
1537                                        (reverse (unLoc $1), reverse (unLoc $3)))
1538                                        [mj AnnRarrow $2] }
1539
1540 varids0 :: { Located [RdrName] }
1541         : {- empty -}                   { noLoc [] }
1542         | varids0 tyvar                 { sLL $1 $> (unLoc $2 : unLoc $1) }
1543
1544 -----------------------------------------------------------------------------
1545 -- Kinds
1546
1547 kind :: { LHsKind RdrName }
1548         : bkind                  { $1 }
1549         | bkind '->' kind        {% ams (sLL $1 $> $ HsFunTy $1 $3)
1550                                         [mj AnnRarrow $2] }
1551
1552 bkind :: { LHsKind RdrName }
1553         : akind                  { $1 }
1554         | bkind akind            { sLL $1 $> $ HsAppTy $1 $2 }
1555
1556 akind :: { LHsKind RdrName }
1557         : '*'                    { sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName) }
1558         | '(' kind ')'           {% ams (sLL $1 $>  $ HsParTy $2)
1559                                         [mo $1,mc $3] }
1560         | pkind                  { $1 }
1561         | tyvar                  { sL1 $1 $ HsTyVar (unLoc $1) }
1562
1563 pkind :: { LHsKind RdrName }  -- promoted type, see Note [Promotion]
1564         : qtycon                          { sL1 $1 $ HsTyVar $ unLoc $1 }
1565         | '(' ')'                   {% ams (sLL $1 $> $ HsTyVar $ getRdrName unitTyCon)
1566                                            [mo $1,mc $2] }
1567         | '(' kind ',' comma_kinds1 ')'   {% ams (sLL $1 $> $ HsTupleTy HsBoxedTuple
1568                                                                      ( $2 : $4))
1569                                                  [mo $1,mj AnnComma $3,mc $5] }
1570         | '[' kind ']'                    {% ams (sLL $1 $> $ HsListTy $2)
1571                                                  [mo $1,mc $3] }
1572
1573 comma_kinds1 :: { [LHsKind RdrName] }
1574         : kind                         { [$1] }
1575         | kind  ',' comma_kinds1       {% addAnnotation (gl $1) AnnComma (gl $2)
1576                                           >> return ($1 : $3) }
1577
1578 {- Note [Promotion]
1579    ~~~~~~~~~~~~~~~~
1580
1581 - Syntax of promoted qualified names
1582 We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
1583 names. Moreover ticks are only allowed in types, not in kinds, for a
1584 few reasons:
1585   1. we don't need quotes since we cannot define names in kinds
1586   2. if one day we merge types and kinds, tick would mean look in DataName
1587   3. we don't have a kind namespace anyway
1588
1589 - Syntax of explicit kind polymorphism  (IA0_TODO: not yet implemented)
1590 Kind abstraction is implicit. We write
1591 > data SList (s :: k -> *) (as :: [k]) where ...
1592 because it looks like what we do in terms
1593 > id (x :: a) = x
1594
1595 - Name resolution
1596 When the user write Zero instead of 'Zero in types, we parse it a
1597 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
1598 deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
1599 bounded in the type level, then we look for it in the term level (we
1600 change its namespace to DataName, see Note [Demotion] in OccName). And
1601 both become a HsTyVar ("Zero", DataName) after the renamer.
1602
1603 -}
1604
1605
1606 -----------------------------------------------------------------------------
1607 -- Datatype declarations
1608
1609 gadt_constrlist :: { Located ([AddAnn]
1610                           ,[LConDecl RdrName]) } -- Returned in order
1611         : 'where' '{'        gadt_constrs '}'   { L (comb2 $1 $3)
1612                                                     ([mj AnnWhere $1
1613                                                      ,mo $2
1614                                                      ,mc $4]
1615                                                     , unLoc $3) }
1616         | 'where' vocurly    gadt_constrs close  { L (comb2 $1 $3)
1617                                                      ([mj AnnWhere $1]
1618                                                      , unLoc $3) }
1619         | {- empty -}                            { noLoc ([],[]) }
1620
1621 gadt_constrs :: { Located [LConDecl RdrName] }
1622         : gadt_constr ';' gadt_constrs
1623                   {% addAnnotation (gl $1) AnnSemi (gl $2)
1624                      >> return (L (comb2 $1 $3) ($1 : unLoc $3)) }
1625         | gadt_constr                   { L (gl $1) [$1] }
1626         | {- empty -}                   { noLoc [] }
1627
1628 -- We allow the following forms:
1629 --      C :: Eq a => a -> T a
1630 --      C :: forall a. Eq a => !a -> T a
1631 --      D { x,y :: a } :: T a
1632 --      forall a. Eq a => D { x,y :: a } :: T a
1633
1634 gadt_constr :: { LConDecl RdrName }
1635                    -- Returns a list because of:   C,D :: ty
1636         : con_list '::' sigtype
1637                 {% do { gadtDecl <- mkGadtDecl (unLoc $1) $3
1638                       ; ams (sLL $1 $> $ gadtDecl)
1639                             [mj AnnDcolon $2] } }
1640
1641                 -- Deprecated syntax for GADT record declarations
1642         | oqtycon '{' fielddecls '}' '::' sigtype
1643                 {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 $3 $6
1644                       ; cd' <- checkRecordSyntax cd
1645                       ; ams (L (comb2 $1 $6) (unLoc cd'))
1646                             [mo $2,mc $4,mj AnnDcolon $5] } }
1647
1648 constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
1649         : maybe_docnext '=' constrs1    { L (comb2 $2 $3) ([mj AnnEqual $2]
1650                                                      ,addConDocs (unLoc $3) $1)}
1651
1652 constrs1 :: { Located [LConDecl RdrName] }
1653         : constrs1 maybe_docnext '|' maybe_docprev constr
1654             {% addAnnotation (gl $5) AnnVbar (gl $3)
1655                >> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
1656         | constr                                          { sL1 $1 [$1] }
1657
1658 constr :: { LConDecl RdrName }
1659         : maybe_docnext forall context '=>' constr_stuff maybe_docprev
1660                 {% ams (let (con,details) = unLoc $5 in
1661                   addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con
1662                                                    (snd $ unLoc $2) $3 details))
1663                             ($1 `mplus` $6))
1664                         (mj AnnDarrow $4:(fst $ unLoc $2)) }
1665         | maybe_docnext forall constr_stuff maybe_docprev
1666                 {% ams ( let (con,details) = unLoc $3 in
1667                   addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con
1668                                            (snd $ unLoc $2) (noLoc []) details))
1669                             ($1 `mplus` $4))
1670                        (fst $ unLoc $2) }
1671
1672 forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) }
1673         : 'forall' tv_bndrs '.'       { sLL $1 $> ([mj AnnForall $1,mj AnnDot $3],$2) }
1674         | {- empty -}                 { noLoc ([],[]) }
1675
1676 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1677 -- We parse the constructor declaration
1678 --      C t1 t2
1679 -- as a btype (treating C as a type constructor) and then convert C to be
1680 -- a data constructor.  Reason: it might continue like this:
1681 --      C t1 t2 %: D Int
1682 -- in which case C really would be a type constructor.  We can't resolve this
1683 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
1684         : btype                         {% splitCon $1 >>= return.sLL $1 $> }
1685         | btype conop btype             {  sLL $1 $> ($2, InfixCon $1 $3) }
1686
1687 fielddecls :: { [LConDeclField RdrName] }
1688         : {- empty -}     { [] }
1689         | fielddecls1     { $1 }
1690
1691 fielddecls1 :: { [LConDeclField RdrName] }
1692         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
1693             {% addAnnotation (gl $1) AnnComma (gl $3) >>
1694                return ((addFieldDoc $1 $4) : addFieldDocs $5 $2) }
1695         | fielddecl   { [$1] }
1696
1697 fielddecl :: { LConDeclField RdrName }
1698                                               -- A list because of   f,g :: Int
1699         : maybe_docnext sig_vars '::' ctype maybe_docprev
1700             {% ams (L (comb2 $2 $4)
1701                       (ConDeclField (reverse (unLoc $2)) $4 ($1 `mplus` $5)))
1702                    [mj AnnDcolon $3] }
1703
1704 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1705 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1706 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1707 -- We don't allow a context, but that's sorted out by the type checker.
1708 deriving :: { Located (Maybe (Located [LHsType RdrName])) }
1709         : {- empty -}             { noLoc Nothing }
1710         | 'deriving' qtycon       {% aljs ( let { L loc tv = $2 }
1711                                             in (sLL $1 $> (Just (sLL $1 $>
1712                                                        [L loc (HsTyVar tv)]))))
1713                                           [mj AnnDeriving $1] }
1714         | 'deriving' '(' ')'      {% aljs (sLL $1 $> (Just (sLL $1 $> [])))
1715                                           [mj AnnDeriving $1,mo $2,mc $3] }
1716
1717         | 'deriving' '(' inst_types1 ')'  {% aljs (sLL $1 $> (Just (sLL $1 $> $3)))
1718                                                  [mj AnnDeriving $1,mo $2,mc $4] }
1719              -- Glasgow extension: allow partial
1720              -- applications in derivings
1721
1722 -----------------------------------------------------------------------------
1723 -- Value definitions
1724
1725 {- Note [Declaration/signature overlap]
1726 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1727 There's an awkward overlap with a type signature.  Consider
1728         f :: Int -> Int = ...rhs...
1729    Then we can't tell whether it's a type signature or a value
1730    definition with a result signature until we see the '='.
1731    So we have to inline enough to postpone reductions until we know.
1732 -}
1733
1734 {-
1735   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1736   instead of qvar, we get another shift/reduce-conflict. Consider the
1737   following programs:
1738
1739      { (^^) :: Int->Int ; }          Type signature; only var allowed
1740
1741      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
1742                                      qvar allowed (because of instance decls)
1743
1744   We can't tell whether to reduce var to qvar until after we've read the signatures.
1745 -}
1746
1747 docdecl :: { LHsDecl RdrName }
1748         : docdecld { sL1 $1 (DocD (unLoc $1)) }
1749
1750 docdecld :: { LDocDecl }
1751         : docnext                               { sL1 $1 (DocCommentNext (unLoc $1)) }
1752         | docprev                               { sL1 $1 (DocCommentPrev (unLoc $1)) }
1753         | docnamed                              { sL1 $1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
1754         | docsection                            { sL1 $1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
1755
1756 decl_no_th :: { Located (OrdList (LHsDecl RdrName)) }
1757         : sigdecl               { $1 }
1758
1759         | '!' aexp rhs          {% do { let { e = sLL $1 $> (SectionR (sLL $1 $> (HsVar bang_RDR)) $2) };
1760                                         pat <- checkPattern empty e;
1761                                         _ <- ams (sLL $1 $> ())
1762                                                (mj AnnBang $1:(fst $ unLoc $3));
1763                                         return $ sLL $1 $> $ unitOL $ sLL $1 $> $ ValD $
1764                                             PatBind pat (snd $ unLoc $3)
1765                                                     placeHolderType
1766                                                     placeHolderNames
1767                                                     (Nothing,[]) } }
1768                                 -- Turn it all into an expression so that
1769                                 -- checkPattern can check that bangs are enabled
1770
1771         | infixexp opt_sig rhs  {% do { r <- checkValDef empty $1 (snd $2) $3;
1772                                         let { l = comb2 $1 $> };
1773                                         case r of {
1774                                           (FunBind n _ _ _ _ _) ->
1775                                                 ams (L l ()) [mj AnnFunId n] >> return () ;
1776                                           _ -> return () } ;
1777                                         _ <- ams (L l ()) (fst $ unLoc $3);
1778                                         return $! (sL l (unitOL $! (sL l $ ValD r))) } }
1779         | pattern_synonym_decl  { sLL $1 $> $ unitOL $1 }
1780         | docdecl               { sLL $1 $> $ unitOL $1 }
1781
1782 decl    :: { Located (OrdList (LHsDecl RdrName)) }
1783         : decl_no_th            { $1 }
1784
1785         -- Why do we only allow naked declaration splices in top-level
1786         -- declarations and not here? Short answer: because readFail009
1787         -- fails terribly with a panic in cvBindsAndSigs otherwise.
1788         | splice_exp            { sLL $1 $> $ unitOL (sLL $1 $> $ mkSpliceDecl $1) }
1789
1790 rhs     :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
1791         : '=' exp wherebinds    { sL (comb3 $1 $2 $3)
1792                                     ((mj AnnEqual $1 : (fst $ unLoc $3))
1793                                     ,GRHSs (unguardedRHS (comb2 $1 $3) $2)
1794                                    (snd $ unLoc $3)) }
1795         | gdrhs wherebinds      { sLL $1 $>  (fst $ unLoc $2
1796                                     ,GRHSs (reverse (unLoc $1))
1797                                                     (snd $ unLoc $2)) }
1798
1799 gdrhs :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
1800         : gdrhs gdrh            { sLL $1 $> ($2 : unLoc $1) }
1801         | gdrh                  { sL1 $1 [$1] }
1802
1803 gdrh :: { LGRHS RdrName (LHsExpr RdrName) }
1804         : '|' guardquals '=' exp  {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
1805                                          [mj AnnVbar $1,mj AnnEqual $3] }
1806
1807 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
1808         :
1809         -- See Note [Declaration/signature overlap] for why we need infixexp here
1810           infixexp '::' sigtypedoc
1811                         {% do ty <- checkPartialTypeSignature $3
1812                         ; s <- checkValSig $1 ty
1813                         ; _ <- ams (sLL $1 $> ()) [mj AnnDcolon $2]
1814                         ; return (sLL $1 $> $ unitOL (sLL $1 $> $ SigD s)) }
1815
1816         | var ',' sig_vars '::' sigtypedoc
1817            {% do { ty <- checkPartialTypeSignature $5
1818                  ; let sig = TypeSig ($1 : reverse (unLoc $3)) ty PlaceHolder
1819                  ; ams (sLL $1 $> $ toOL [ sLL $1 $> $ SigD sig ])
1820                        [mj AnnComma $2,mj AnnDcolon $4] } }
1821
1822         | infix prec ops
1823               {% ams (sLL $1 $> $ toOL [ sLL $1 $> $ SigD
1824                         (FixSig (FixitySig (fromOL $ unLoc $3)
1825                                 (Fixity (unLoc $2) (unLoc $1)))) ])
1826                      [mj AnnInfix $1,mj AnnVal $2] }
1827
1828         | pattern_synonym_sig   { sLL $1 $> $ unitOL $ sLL $1 $> . SigD . unLoc $ $1 }
1829
1830         | '{-# INLINE' activation qvar '#-}'
1831                 {% ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (InlineSig $3
1832                                      (mkInlinePragma (getINLINE $1) (snd $2)))))
1833                        (mo $1:mc $4:fst $2) }
1834
1835         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
1836              {% ams (
1837                  let inl_prag = mkInlinePragma (EmptyInlineSpec, FunLike) (snd $2)
1838                   in sLL $1 $> $
1839                             toOL [ sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag) ])
1840                     (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
1841
1842         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
1843              {% ams (sLL $1 $> $ toOL [ sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
1844                                (mkInlinePragma (getSPEC_INLINE $1) (snd $2))) ])
1845                        (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
1846
1847         | '{-# SPECIALISE' 'instance' inst_type '#-}'
1848                 {% ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (SpecInstSig $3)))
1849                        [mo $1,mj AnnInstance $2,mc $4] }
1850
1851         -- AZ TODO: Do we need locations in the name_formula_opt?
1852         -- A minimal complete definition
1853         | '{-# MINIMAL' name_boolformula_opt '#-}'
1854             {% ams (sLL $1 $> $ unitOL (sLL $1 $> $ SigD (MinimalSig (snd $2))))
1855                    (mo $1:mc $3:fst $2) }
1856
1857 activation :: { ([AddAnn],Maybe Activation) }
1858         : {- empty -}                           { ([],Nothing) }
1859         | explicit_activation                   { (fst $1,Just (snd $1)) }
1860
1861 explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
1862         : '[' INTEGER ']'       { ([mj AnnOpen $1,mj AnnVal $2,mj AnnClose $3]
1863                                   ,ActiveAfter  (fromInteger (getINTEGER $2))) }
1864         | '[' '~' INTEGER ']'   { ([mj AnnOpen $1,mj AnnTilde $2,mj AnnVal $3
1865                                                  ,mj AnnClose $4]
1866                                   ,ActiveBefore (fromInteger (getINTEGER $3))) }
1867
1868 -----------------------------------------------------------------------------
1869 -- Expressions
1870
1871 quasiquote :: { Located (HsQuasiQuote RdrName) }
1872         : TH_QUASIQUOTE   { let { loc = getLoc $1
1873                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
1874                                 ; quoterId = mkUnqual varName quoter }
1875                             in sL1 $1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
1876         | TH_QQUASIQUOTE  { let { loc = getLoc $1
1877                                 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
1878                                 ; quoterId = mkQual varName (qual, quoter) }
1879                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
1880
1881 exp   :: { LHsExpr RdrName }
1882         : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 $3 PlaceHolder)
1883                                        [mj AnnDcolon $2] }
1884         | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
1885                                                         HsFirstOrderApp True)
1886                                        [mj Annlarrowtail $2] }
1887         | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
1888                                                       HsFirstOrderApp False)
1889                                        [mj Annrarrowtail $2] }
1890         | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
1891                                                       HsHigherOrderApp True)
1892                                        [mj AnnLarrowtail $2] }
1893         | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
1894                                                       HsHigherOrderApp False)
1895                                        [mj AnnRarrowtail $2] }
1896         | infixexp              { $1 }
1897
1898 infixexp :: { LHsExpr RdrName }
1899         : exp10                       { $1 }
1900         | infixexp qop exp10          { sLL $1 $> (OpApp $1 $2 placeHolderFixity $3) }
1901
1902 exp10 :: { LHsExpr RdrName }
1903         : '\\' apat apats opt_asig '->' exp
1904                    {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
1905                             [sLL $1 $> $ Match ($2:$3) (snd $4) (unguardedGRHSs $6)]))
1906                           [mj AnnLam $1,mj AnnRarrow $5] }
1907         | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
1908                                                (mj AnnLet $1:mj AnnIn $3
1909                                                  :(fst $ unLoc $2)) }
1910         | '\\' 'lcase' altslist
1911             {% ams (sLL $1 $> $ HsLamCase placeHolderType
1912                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
1913                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
1914         | 'if' exp optSemi 'then' exp optSemi 'else' exp
1915                            {% checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >>
1916                               ams (sLL $1 $> $ mkHsIf $2 $5 $8)
1917                                   (mj AnnIf $1:mj AnnThen $4
1918                                      :mj AnnElse $7
1919                                      :(map (\l -> mj AnnSemi l) (fst $3))
1920                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
1921         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
1922                                            ams (sLL $1 $> $ HsMultiIf
1923                                                      placeHolderType
1924                                                      (reverse $ snd $ unLoc $2))
1925                                                (mj AnnIf $1:(fst $ unLoc $2)) }
1926         | 'case' exp 'of' altslist      {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
1927                                                    FromSource (snd $ unLoc $4)))
1928                                                (mj AnnCase $1:mj AnnOf $3
1929                                                   :(fst $ unLoc $4)) }
1930         | '-' fexp                      {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
1931                                                [mj AnnMinus $1] }
1932
1933         | 'do' stmtlist              {% ams (L (comb2 $1 $2)
1934                                                (mkHsDo DoExpr (snd $ unLoc $2)))
1935                                                (mj AnnDo $1:(fst $ unLoc $2)) }
1936         | 'mdo' stmtlist            {% ams (L (comb2 $1 $2)
1937                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
1938                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
1939
1940         | scc_annot exp        {% do { on <- extension sccProfilingOn
1941                                      ; ams (sLL $1 $> $ if on
1942                                                          then HsSCC (snd $ unLoc $1) $2
1943                                                          else HsPar $2)
1944                                            (fst $ unLoc $1) } }
1945
1946         | hpc_annot exp        {% do { on <- extension hpcEnabled
1947                                        ; ams (sLL $1 $> $ if on
1948                                                            then HsTickPragma
1949                                                                     (snd $ unLoc $1) $2
1950                                                            else HsPar $2)
1951                                              (fst $ unLoc $1) } }
1952
1953         | 'proc' aexp '->' exp
1954                        {% checkPattern empty $2 >>= \ p ->
1955                            checkCommand $4 >>= \ cmd ->
1956                            ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
1957                                                 placeHolderType []))
1958                                             -- TODO: is LL right here?
1959                                [mj AnnProc $1,mj AnnRarrow $3] }
1960
1961         | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getSTRING $2) $4)
1962                                               [mo $1,mj AnnVal $2
1963                                               ,mc $3] }
1964                                           -- hdaume: core annotation
1965         | fexp                         { $1 }
1966
1967         -- parsing error messages go below here
1968         | '\\' apat apats opt_asig '->'              {% parseErrorSDoc (combineLocs $1 $5) $ text
1969                                                         "parse error in lambda: no expression after '->'"
1970                                                      }
1971         | '\\'                                       {% parseErrorSDoc (getLoc $1) $ text
1972                                                         "parse error: naked lambda expression '\'"
1973                                                      }
1974         | 'let' binds 'in'                           {% parseErrorSDoc (combineLocs $1 $2) $ text
1975                                                         "parse error in let binding: missing expression after 'in'"
1976                                                      }
1977         | 'let' binds                                {% parseErrorSDoc (combineLocs $1 $2) $ text
1978                                                         "parse error in let binding: missing required 'in'"
1979                                                      }
1980         | 'let'                                      {% parseErrorSDoc (getLoc $1) $ text
1981                                                         "parse error: naked let binding"
1982                                                      }
1983         | 'if' exp optSemi 'then' exp optSemi 'else' {% hintIf (combineLocs $1 $5) "else clause empty" }
1984         | 'if' exp optSemi 'then' exp optSemi        {% hintIf (combineLocs $1 $5) "missing required else clause" }
1985         | 'if' exp optSemi 'then'                    {% hintIf (combineLocs $1 $2) "then clause empty" }
1986         | 'if' exp optSemi                           {% hintIf (combineLocs $1 $2) "missing required then and else clauses" }
1987         | 'if'                                       {% hintIf (getLoc $1) "naked if statement" }
1988         | 'case' exp 'of'                            {% parseErrorSDoc (combineLocs $1 $2) $ text
1989                                                         "parse error in case statement: missing list after '->'"
1990                                                      }
1991         | 'case' exp                                 {% parseErrorSDoc (combineLocs $1 $2) $ text
1992                                                         "parse error in case statement: missing required 'of'"
1993                                                      }
1994         | 'case'                                     {% parseErrorSDoc (getLoc $1) $ text
1995                                                         "parse error: naked case statement"
1996                                                      }
1997 optSemi :: { ([Located a],Bool) }
1998         : ';'         { ([$1],True) }
1999         | {- empty -} { ([],False) }
2000
2001 scc_annot :: { Located ([AddAnn],FastString) }
2002         : '{-# SCC' STRING '#-}'      {% do scc <- getSCC $2
2003                                             ; return $ sLL $1 $>
2004                                                ([mo $1,mj AnnVal $2
2005                                                 ,mc $3],scc) }
2006         | '{-# SCC' VARID  '#-}'      { sLL $1 $> ([mo $1,mj AnnVal $2
2007                                          ,mc $3]
2008                                         ,(getVARID $2)) }
2009
2010 hpc_annot :: { Located ([AddAnn],(FastString,(Int,Int),(Int,Int))) }
2011       : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
2012                                       { sLL $1 $> $ ([mo $1,mj AnnVal $2
2013                                               ,mj AnnVal $3,mj AnnColon $4
2014                                               ,mj AnnVal $5,mj AnnMinus $6
2015                                               ,mj AnnVal $7,mj AnnColon $8
2016                                               ,mj AnnVal $9,mc $10]
2017                                               ,(getSTRING $2
2018                                                ,( fromInteger $ getINTEGER $3
2019                                                 , fromInteger $ getINTEGER $5
2020                                                 )
2021                                                ,( fromInteger $ getINTEGER $7
2022                                                 , fromInteger $ getINTEGER $9
2023                                                 )
2024                                                ))
2025                                          }
2026
2027 fexp    :: { LHsExpr RdrName }
2028         : fexp aexp                             { sLL $1 $> $ HsApp $1 $2 }
2029         | 'static' aexp                         { sLL $1 $> $ HsStatic $2 }
2030         | aexp                                  { $1 }
2031
2032 aexp    :: { LHsExpr RdrName }
2033         : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
2034         | '~' aexp              {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
2035         | aexp1                 { $1 }
2036
2037 aexp1   :: { LHsExpr RdrName }
2038         : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
2039                                                                    (snd $3)
2040                                      ; _ <- ams (sLL $1 $> ()) (mo $2:mc $4:(fst $3))
2041                                      ; checkRecordSyntax (sLL $1 $> r) }}
2042         | aexp2                { $1 }
2043
2044 aexp2   :: { LHsExpr RdrName }
2045         : ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
2046         | qcname                        { sL1 $1 (HsVar   $! unLoc $1) }
2047         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
2048 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
2049 -- into HsOverLit when -foverloaded-strings is on.
2050 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
2051 --                                       (getSTRING $1) placeHolderType) }
2052         | INTEGER   { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGERs $1)
2053                                          (getINTEGER $1) placeHolderType) }
2054         | RATIONAL  { sL (getLoc $1) (HsOverLit $! mkHsFractional
2055                                           (getRATIONAL $1) placeHolderType) }
2056
2057         -- N.B.: sections get parsed by these next two productions.
2058         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
2059         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
2060         -- but the less cluttered version fell out of having texps.
2061         | '(' texp ')'                  {% ams (sLL $1 $> (HsPar $2)) [mo $1,mc $3] }
2062         | '(' tup_exprs ')'             {% ams (sLL $1 $> (ExplicitTuple $2 Boxed))
2063                                                [mo $1,mc $3] }
2064
2065         | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple [L (gl $2)
2066                                                          (Present $2)] Unboxed))
2067                                                [mo $1,mc $3] }
2068         | '(#' tup_exprs '#)'           {% ams (sLL $1 $> (ExplicitTuple $2 Unboxed))
2069                                                [mo $1,mc $3] }
2070
2071         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
2072         | '[:' parr ':]'    {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
2073         | '_'               { sL1 $1 EWildPat }
2074
2075         -- Template Haskell Extension
2076         | splice_exp            { $1 }
2077
2078         | SIMPLEQUOTE  qvar     { sLL $1 $> $ HsBracket (VarBr True  (unLoc $2)) }
2079         | SIMPLEQUOTE  qcon     { sLL $1 $> $ HsBracket (VarBr True  (unLoc $2)) }
2080         | TH_TY_QUOTE tyvar     { sLL $1 $> $ HsBracket (VarBr False (unLoc $2)) }
2081         | TH_TY_QUOTE gtycon    { sLL $1 $> $ HsBracket (VarBr False (unLoc $2)) }
2082         | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2)) [mo $1,mc $3] }
2083         | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2)) [mo $1,mc $3]}
2084         | '[t|' ctype '|]'    {% checkNoPartialType
2085                                    (text "in type brackets" <> colon
2086                                     <+> quotes (text "[t|" <+> ppr $2 <+> text "|]")) $2 >>
2087                                  ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mc $3] }
2088         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
2089                                       ams (sLL $1 $> $ HsBracket (PatBr p))
2090                                           [mo $1,mc $3] }
2091         | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
2092                                       (mo $1:mc $3:fst $2) }
2093         | quasiquote          { sL1 $1 (HsQuasiQuoteE (unLoc $1)) }
2094
2095         -- arrow notation extension
2096         | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm $2
2097                                                            Nothing (reverse $3))
2098                                           [mo $1,mc $4] }
2099
2100 splice_exp :: { LHsExpr RdrName }
2101         : TH_ID_SPLICE          { sL1 $1 $ mkHsSpliceE
2102                                         (sL1 $1 $ HsVar (mkUnqual varName
2103                                                         (getTH_ID_SPLICE $1))) }
2104         | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE $2) [mo $1,mc $3] }
2105         | TH_ID_TY_SPLICE       { sL1 $1 $ mkHsSpliceTE
2106                                         (sL1 $1 $ HsVar (mkUnqual varName
2107                                                      (getTH_ID_TY_SPLICE $1))) }
2108         | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE $2) [mo $1,mc $3] }
2109
2110 cmdargs :: { [LHsCmdTop RdrName] }
2111         : cmdargs acmd                  { $2 : $1 }
2112         | {- empty -}                   { [] }
2113
2114 acmd    :: { LHsCmdTop RdrName }
2115         : aexp2                 {% checkCommand $1 >>= \ cmd ->
2116                                     return (sL1 $1 $ HsCmdTop cmd
2117                                            placeHolderType placeHolderType []) }
2118
2119 cvtopbody :: { ([AddAnn],[LHsDecl RdrName]) }
2120         :  '{'            cvtopdecls0 '}'      { ([mj AnnOpen $1
2121                                                   ,mj AnnClose $3],$2) }
2122         |      vocurly    cvtopdecls0 close    { ([],$2) }
2123
2124 cvtopdecls0 :: { [LHsDecl RdrName] }
2125         : {- empty -}           { [] }
2126         | cvtopdecls            { $1 }
2127
2128 -----------------------------------------------------------------------------
2129 -- Tuple expressions
2130
2131 -- "texp" is short for tuple expressions:
2132 -- things that can appear unparenthesized as long as they're
2133 -- inside parens or delimitted by commas
2134 texp :: { LHsExpr RdrName }
2135         : exp                           { $1 }
2136
2137         -- Note [Parsing sections]
2138         -- ~~~~~~~~~~~~~~~~~~~~~~~
2139         -- We include left and right sections here, which isn't
2140         -- technically right according to the Haskell standard.
2141         -- For example (3 +, True) isn't legal.
2142         -- However, we want to parse bang patterns like
2143         --      (!x, !y)
2144         -- and it's convenient to do so here as a section
2145         -- Then when converting expr to pattern we unravel it again
2146         -- Meanwhile, the renamer checks that real sections appear
2147         -- inside parens.
2148         | infixexp qop        { sLL $1 $> $ SectionL $1 $2 }
2149         | qopm infixexp       { sLL $1 $> $ SectionR $1 $2 }
2150
2151        -- View patterns get parenthesized above
2152         | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] }
2153
2154 -- Always at least one comma
2155 tup_exprs :: { [LHsTupArg RdrName] }
2156            : texp commas_tup_tail
2157                           {% do { addAnnotation (gl $1) AnnComma (fst $2)
2158                                 ; return ((L (gl $1) (Present $1)) : snd $2) } }
2159
2160            | commas tup_tail
2161                 {% do { mapM_ (\ll -> addAnnotation (gl ll) AnnComma (gl ll)) $2
2162                       ; return
2163                            (let tt = if null $2
2164                                        then [noLoc missingTupArg]
2165                                        else $2
2166                             in map (\l -> L l missingTupArg) (fst $1) ++ tt) } }
2167
2168 -- Always starts with commas; always follows an expr
2169 commas_tup_tail :: { (SrcSpan,[LHsTupArg RdrName]) }
2170 commas_tup_tail : commas tup_tail
2171        {% do { mapM_ (\ll -> addAnnotation ll AnnComma ll) (tail $ fst $1)
2172              ; return (
2173          let tt = if null $2
2174                     then [L (last $ fst $1) missingTupArg]
2175                     else $2
2176          in (head $ fst $1
2177             ,(map (\l -> L l missingTupArg) (init $ fst $1)) ++ tt)) } }
2178
2179 -- Always follows a comma
2180 tup_tail :: { [LHsTupArg RdrName] }
2181           : texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
2182                                     return ((L (gl $1) (Present $1)) : snd $2) }
2183           | texp                 { [L (gl $1) (Present $1)] }
2184           | {- empty -}          { [] {- [noLoc missingTupArg] -} }
2185
2186 -----------------------------------------------------------------------------
2187 -- List expressions
2188
2189 -- The rules below are little bit contorted to keep lexps left-recursive while
2190 -- avoiding another shift/reduce-conflict.
2191 list :: { ([AddAnn],HsExpr RdrName) }
2192         : texp    { ([],ExplicitList placeHolderType Nothing [$1]) }
2193         | lexps   { ([],ExplicitList placeHolderType Nothing
2194                                                    (reverse (unLoc $1))) }
2195         | texp '..'             { ([mj AnnDotdot $2],
2196                                       ArithSeq noPostTcExpr Nothing (From $1)) }
2197         | texp ',' exp '..'     { ([mj AnnComma $2,mj AnnDotdot $4],
2198                                   ArithSeq noPostTcExpr Nothing
2199                                                              (FromThen $1 $3)) }
2200         | texp '..' exp         { ([mj AnnDotdot $2],
2201                                    ArithSeq noPostTcExpr Nothing
2202                                                                (FromTo $1 $3)) }
2203         | texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
2204                                     ArithSeq noPostTcExpr Nothing
2205                                                 (FromThenTo $1 $3 $5)) }
2206         | texp '|' flattenedpquals
2207              {% checkMonadComp >>= \ ctxt ->
2208                 return ([mj AnnVbar $2],
2209                         mkHsComp ctxt (unLoc $3) $1) }
2210
2211 lexps :: { Located [LHsExpr RdrName] }
2212         : lexps ',' texp          {% addAnnotation (gl $ head $ unLoc $1)
2213                                                             AnnComma (gl $2) >>
2214                                       return (sLL $1 $> (((:) $! $3) $! unLoc $1)) }
2215         | texp ',' texp            {% addAnnotation (gl $1) AnnComma (gl $2) >>
2216                                       return (sLL $1 $> [$3,$1]) }
2217
2218 -----------------------------------------------------------------------------
2219 -- List Comprehensions
2220
2221 flattenedpquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2222     : pquals   { case (unLoc $1) of
2223                     [qs] -> sL1 $1 qs
2224                     -- We just had one thing in our "parallel" list so
2225                     -- we simply return that thing directly
2226
2227                     qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock qs [] noSyntaxExpr |
2228                                             qs <- qss]
2229                                             noSyntaxExpr noSyntaxExpr]
2230                     -- We actually found some actual parallel lists so
2231                     -- we wrap them into as a ParStmt
2232                 }
2233
2234 pquals :: { Located [[LStmt RdrName (LHsExpr RdrName)]] }
2235     : squals '|' pquals
2236                      {% addAnnotation (gl $ last $ unLoc $1) AnnVbar (gl $2) >>
2237                         return (L (getLoc $2) (reverse (unLoc $1) : unLoc $3)) }
2238     | squals         { L (getLoc $1) [reverse (unLoc $1)] }
2239
2240 squals :: { Located [LStmt RdrName (LHsExpr RdrName)] }   -- In reverse order, because the last
2241                                         -- one can "grab" the earlier ones
2242     : squals ',' transformqual
2243              {% addAnnotation (gl $ last $ unLoc $1) AnnComma (gl $2) >>
2244                 return (sLL $1 $> [L (getLoc $3) ((unLoc $3) (reverse (unLoc $1)))]) }
2245     | squals ',' qual
2246              {% addAnnotation (gl $ last $ unLoc $1) AnnComma (gl $2) >>
2247                 return (sLL $1 $> ($3 : unLoc $1)) }
2248     | transformqual                       { sLL $1 $> [L (getLoc $1) ((unLoc $1) [])] }
2249     | qual                                { sL1 $1 [$1] }
2250 --  | transformquals1 ',' '{|' pquals '|}'   { sLL $1 $> ($4 : unLoc $1) }
2251 --  | '{|' pquals '|}'                       { sL1 $1 [$2] }
2252
2253 -- It is possible to enable bracketing (associating) qualifier lists
2254 -- by uncommenting the lines with {| |} above. Due to a lack of
2255 -- consensus on the syntax, this feature is not being used until we
2256 -- get user demand.
2257
2258 transformqual :: { Located ([LStmt RdrName (LHsExpr RdrName)] -> Stmt RdrName (LHsExpr RdrName)) }
2259                         -- Function is applied to a list of stmts *in order*
2260     : 'then' exp               {% ams (sLL $1 $> $ \ss -> (mkTransformStmt ss $2))
2261                                       [mj AnnThen $1] }
2262     | 'then' exp 'by' exp      {% ams (sLL $1 $> $ \ss -> (mkTransformByStmt ss $2 $4))
2263                                       [mj AnnThen $1,mj AnnBy  $3] }
2264     | 'then' 'group' 'using' exp
2265              {% ams (sLL $1 $> $ \ss -> (mkGroupUsingStmt ss $4))
2266                     [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] }
2267
2268     | 'then' 'group' 'by' exp 'using' exp
2269              {% ams (sLL $1 $> $ \ss -> (mkGroupByUsingStmt ss $4 $6))
2270                      [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] }
2271
2272 -- Note that 'group' is a special_id, which means that you can enable
2273 -- TransformListComp while still using Data.List.group. However, this
2274 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
2275 -- in by choosing the "group by" variant, which is what we want.
2276
2277 -----------------------------------------------------------------------------
2278 -- Parallel array expressions
2279
2280 -- The rules below are little bit contorted; see the list case for details.
2281 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
2282 -- Moreover, we allow explicit arrays with no element (represented by the nil
2283 -- constructor in the list case).
2284
2285 parr :: { ([AddAnn],HsExpr RdrName) }
2286         :                      { ([],ExplicitPArr placeHolderType []) }
2287         | texp                 { ([],ExplicitPArr placeHolderType [$1]) }
2288         | lexps                { ([],ExplicitPArr placeHolderType
2289                                                           (reverse (unLoc $1))) }
2290         | texp '..' exp        { ([mj AnnDotdot $2]
2291                                  ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
2292         | texp ',' exp '..' exp
2293                         { ([mj AnnComma $2,mj AnnDotdot $4]
2294                           ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
2295         | texp '|' flattenedpquals
2296                         { ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
2297
2298 -- We are reusing `lexps' and `flattenedpquals' from the list case.
2299
2300 -----------------------------------------------------------------------------
2301 -- Guards
2302
2303 guardquals :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2304     : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
2305
2306 guardquals1 :: { Located [LStmt RdrName (LHsExpr RdrName)] }
2307     : guardquals1 ',' qual  {% ams (sLL $1 $> ($3 : unLoc $1)) [mj AnnComma $2] }
2308     | qual                  { sL1 $1 [$1] }
2309
2310 -----------------------------------------------------------------------------
2311 -- Case alternatives
2312
2313 altslist :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
2314         : '{'            alts '}'    { sLL $1 $> ([mo $1,mc $3],(reverse (unLoc $2))) }
2315
2316         |     vocurly    alts  close { L (getLoc $2) ([],(reverse (unLoc $2))) }
2317         | '{'                 '}'    { noLoc ([mo $1,mc $2],[]) }
2318         |     vocurly          close { noLoc ([],[]) }
2319
2320 alts    :: { Located [LMatch RdrName (LHsExpr RdrName)] }
2321         : alts1                         { sL1 $1 (unLoc $1) }
2322         | ';' alts                      {% ams (sLL $1 $> (unLoc $2))
2323                                                [mj AnnSemi (head $ unLoc $2)] }
2324
2325 alts1   :: { Located [LMatch RdrName (LHsExpr RdrName)] }
2326         : alts1 ';' alt           {% ams (sLL $1 $> ($3 : unLoc $1)) [mj AnnSemi $3] }
2327         | alts1 ';'               {% ams (sLL $1 $> (unLoc $1))
2328                                          [mj AnnSemi (last $ unLoc $1)] }
2329         | alt                     { sL1 $1 [$1] }
2330
2331 alt     :: { LMatch RdrName (LHsExpr RdrName) }
2332         : pat opt_sig alt_rhs           { sLL $1 $> (Match [$1] (snd $2) (unLoc $3)) }
2333
2334 alt_rhs :: { Located (GRHSs RdrName (LHsExpr RdrName)) }
2335         : ralt wherebinds           {% ams (sLL $1 $> (GRHSs (unLoc $1)
2336                                                              (snd $ unLoc $2)))
2337                                            (fst $ unLoc $2) }
2338
2339 ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2340         : '->' exp            {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
2341                                      [mj AnnRarrow $1] }
2342         | gdpats              { sL1 $1 (reverse (unLoc $1)) }
2343
2344 gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2345         : gdpats gdpat                  { sLL $1 $> ($2 : unLoc $1) }
2346         | gdpat                         { sL1 $1 [$1] }
2347
2348 -- optional semi-colons between the guards of a MultiWayIf, because we use
2349 -- layout here, but we don't need (or want) the semicolon as a separator (#7783).
2350 gdpatssemi :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
2351         : gdpatssemi gdpat optSemi  {% ams (sL (comb2 $1 $2) ($2 : unLoc $1))
2352                                            (map (\l -> mj AnnSemi l) $ fst $3) }
2353         | gdpat optSemi             {% ams (sL1 $1 [$1])
2354                                            (map (\l -> mj AnnSemi l) $ fst $2) }
2355
2356 -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
2357 -- generate the open brace in addition to the vertical bar in the lexer, and
2358 -- we don't need it.
2359 ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
2360          : '{' gdpatssemi '}'             { sLL $1 $> ([mo $1,mc $3],unLoc $2)  }
2361          |     gdpatssemi close           { sL1 $1 ([],unLoc $1) }
2362
2363 gdpat   :: { LGRHS RdrName (LHsExpr RdrName) }
2364         : '|' guardquals '->' exp
2365                                   {% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
2366                                          [mj AnnVbar $1,mj AnnRarrow $3] }
2367
2368 -- 'pat' recognises a pattern, including one with a bang at the top
2369 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
2370 -- Bangs inside are parsed as infix operator applications, so that
2371 -- we parse them right when bang-patterns are off
2372 pat     :: { LPat RdrName }
2373 pat     :  exp          {% checkPattern empty $1 }
2374         | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR
2375                                                      (sL1 $1 (HsVar bang_RDR)) $2)))
2376                                 [mj AnnBang $1] }
2377
2378 bindpat :: { LPat RdrName }
2379 bindpat :  exp            {% checkPattern
2380                                 (text "Possibly caused by a missing 'do'?") $1 }
2381         | '!' aexp        {% amms (checkPattern
2382                                      (text "Possibly caused by a missing 'do'?")
2383                                      (sLL $1 $> (SectionR (sL1 $1 (HsVar bang_RDR)) $2)))
2384                                   [mj AnnBang $1] }
2385
2386 apat   :: { LPat RdrName }
2387 apat    : aexp                  {% checkPattern empty $1 }
2388         | '!' aexp              {% amms (checkPattern empty
2389                                             (sLL $1 $> (SectionR
2390                                                 (sL1 $1 (HsVar bang_RDR)) $2)))
2391                                         [mj AnnBang $1] }
2392
2393 apats  :: { [LPat RdrName] }
2394         : apat apats            { $1 : $2 }
2395         | {- empty -}           { [] }
2396
2397 -----------------------------------------------------------------------------
2398 -- Statement sequences
2399
2400 stmtlist :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2401         : '{'           stmts '}'       { sLL $1 $> ((mo $1:mc $3:(fst $ unLoc $2))
2402                                              ,(snd $ unLoc $2)) }
2403         |     vocurly   stmts close     { L (gl $2) (fst $ unLoc $2
2404                                                     ,snd $ unLoc $2) }
2405
2406 --      do { ;; s ; s ; ; s ;; }
2407 -- The last Stmt should be an expression, but that's hard to enforce
2408 -- here, because we need too much lookahead if we see do { e ; }
2409 -- So we use BodyStmts throughout, and switch the last one over
2410 -- in ParseUtils.checkDo instead
2411 -- AZ: TODO check that we can retrieve multiple semis.
2412 stmts :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2413         : stmt stmts_help        { sLL $1 $> (fst $ unLoc $2,($1 : (snd $ unLoc $2))) }
2414         | ';' stmts     {% if null (snd $ unLoc $2)
2415                              then ams (sLL $1 $> ([mj AnnSemi $1],snd $ unLoc $2)) []
2416                              else ams (sLL $1 $> ([],snd $ unLoc $2)) [mj AnnSemi $1] }
2417
2418         | {- empty -}            { noLoc ([],[]) }
2419
2420 stmts_help :: { Located ([AddAnn],[LStmt RdrName (LHsExpr RdrName)]) }
2421                                                                -- might be empty
2422         : ';' stmts    {% if null (snd $ unLoc $2)
2423                              then ams (sLL $1 $> ([mj AnnSemi $1],snd $ unLoc $2)) []
2424                              else ams (sLL $1 $> ([],snd $ unLoc $2)) [mj AnnSemi $1] }
2425
2426         | {- empty -}                   { noLoc ([],[]) }
2427
2428 -- For typing stmts at the GHCi prompt, where
2429 -- the input may consist of just comments.
2430 maybe_stmt :: { Maybe (LStmt RdrName (LHsExpr RdrName)) }
2431         : stmt                          { Just $1 }
2432         | {- nothing -}                 { Nothing }
2433
2434 stmt  :: { LStmt RdrName (LHsExpr RdrName) }
2435         : qual                          { $1 }
2436         | 'rec' stmtlist                {% ams (sLL $1 $> $ mkRecStmt (snd $ unLoc $2))
2437                                                [mj AnnRec $1] }
2438
2439 qual  :: { LStmt RdrName (LHsExpr RdrName) }
2440     : bindpat '<-' exp                  {% ams (sLL $1 $> $ mkBindStmt $1 $3)
2441                                                [mj AnnLarrow $2] }
2442     | exp                               { sL1 $1 $ mkBodyStmt $1 }
2443     | 'let' binds                       {% ams (sLL $1 $>$ LetStmt (snd $ unLoc $2))
2444                                                [mj AnnLet $1] }
2445
2446 -----------------------------------------------------------------------------
2447 -- Record Field Update/Construction
2448
2449 fbinds  :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2450         : fbinds1                       { $1 }
2451         | {- empty -}                   { ([],([], False)) }
2452
2453 fbinds1 :: { ([AddAnn],([LHsRecField RdrName (LHsExpr RdrName)], Bool)) }
2454         : fbind ',' fbinds1
2455                 {% addAnnotation (gl $1) AnnComma (gl $2) >>
2456                    return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
2457         | fbind                         { ([],([$1], False)) }
2458         | '..'                          { ([mj AnnDotdot $1],([],   True)) }
2459
2460 fbind   :: { LHsRecField RdrName (LHsExpr RdrName) }
2461         : qvar '=' texp {% ams  (sLL $1 $> $ HsRecField $1 $3             False)
2462                                 [mj AnnEqual $2] }
2463                         -- RHS is a 'texp', allowing view patterns (Trac #6038)
2464                         -- and, incidentaly, sections.  Eg
2465                         -- f (R { x = show -> s }) = ...
2466
2467         | qvar          { sLL $1 $> $ HsRecField $1 placeHolderPunRhs True }
2468                         -- In the punning case, use a place-holder
2469                         -- The renamer fills in the final value
2470
2471 -----------------------------------------------------------------------------
2472 -- Implicit Parameter Bindings
2473
2474 dbinds  :: { Located [LIPBind RdrName] }
2475         : dbinds ';' dbind
2476                       {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2477                          return (let { this = $3; rest = unLoc $1 }
2478                               in rest `seq` this `seq` sLL $1 $> (this : rest)) }
2479         | dbinds ';'  {% addAnnotation (gl $ last $ unLoc $1) AnnSemi (gl $2) >>
2480                          return (sLL $1 $> (unLoc $1)) }
2481         | dbind                        { let this = $1 in this `seq` sL1 $1 [this] }
2482 --      | {- empty -}                  { [] }
2483
2484 dbind   :: { LIPBind RdrName }
2485 dbind   : ipvar '=' exp                {% ams (sLL $1 $> (IPBind (Left (unLoc $1)) $3))
2486                                               [mj AnnEqual $2] }
2487
2488 ipvar   :: { Located HsIPName }
2489         : IPDUPVARID            { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
2490
2491 -----------------------------------------------------------------------------
2492 -- Warnings and deprecations
2493
2494 name_boolformula_opt :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2495         : name_boolformula          { $1 }
2496         | {- empty -}               { ([],mkTrue) }
2497
2498 name_boolformula :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2499         : name_boolformula_and                      { $1 }
2500         | name_boolformula_and '|' name_boolformula
2501                                              { ((mj AnnVbar $2:fst $1)++(fst $3)
2502                                                 ,mkOr [snd $1,snd $3]) }
2503
2504 name_boolformula_and :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2505         : name_boolformula_atom                             { $1 }
2506         | name_boolformula_atom ',' name_boolformula_and
2507                   { ((mj AnnComma $2:fst $1)++(fst $3), mkAnd [snd $1,snd $3]) }
2508
2509 name_boolformula_atom :: { ([AddAnn],BooleanFormula (Located RdrName)) }
2510         : '(' name_boolformula ')'  { ([mo $1,mc $3],snd $2) }
2511         | name_var                  { ([],mkVar $1) }
2512
2513 -- AZ TODO: warnings/deprecations are incompletely annotated
2514 namelist :: { Located [RdrName] }
2515 namelist : name_var              { sL1 $1 [unLoc $1] }
2516          | name_var ',' namelist { sLL $1 $> (unLoc $1 : unLoc $3) }
2517
2518 name_var :: { Located RdrName }
2519 name_var : var { $1 }
2520          | con { $1 }
2521
2522 -----------------------------------------
2523 -- Data constructors
2524 qcon    :: { Located RdrName }
2525         : qconid                { $1 }
2526         | '(' qconsym ')'       {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2527         | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2528 -- The case of '[:' ':]' is part of the production `parr'
2529
2530 con     :: { Located RdrName }
2531         : conid                 { $1 }
2532         | '(' consym ')'        {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2533         | sysdcon               { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) }
2534
2535 con_list :: { Located [Located RdrName] }
2536 con_list : con                  { sL1 $1 [$1] }
2537          | con ',' con_list     {% ams (sLL $1 $> ($1 : unLoc $3)) [mj AnnComma $2] }
2538
2539 sysdcon :: { Located DataCon }  -- Wired in data constructors
2540         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mo $1,mc $2] }
2541         | '(' commas ')'        {% ams (sLL $1 $> $ tupleCon BoxedTuple (snd $2 + 1))
2542                                        (mo $1:mc $3:(mcommas (fst $2))) }
2543         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
2544         | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleCon UnboxedTuple (snd $2 + 1))
2545                                        (mo $1:mc $3:(mcommas (fst $2))) }
2546         | '[' ']'               {% ams (sLL $1 $> nilDataCon) [mo $1,mc $2] }
2547
2548 conop :: { Located RdrName }
2549         : consym                { $1 }
2550         | '`' conid '`'         {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2551
2552 qconop :: { Located RdrName }
2553         : qconsym               { $1 }
2554         | '`' qconid '`'        {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2555
2556 ----------------------------------------------------------------------------
2557 -- Type constructors
2558
2559
2560 -- See Note [Unit tuples] in HsTypes for the distinction
2561 -- between gtycon and ntgtycon
2562 gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
2563         : ntgtycon                     { $1 }
2564         | '(' ')'                      {% ams (sLL $1 $> $ getRdrName unitTyCon)
2565                                               [mo $1,mc $2] }
2566         | '(#' '#)'                    {% ams (sLL $1 $> $ getRdrName unboxedUnitTyCon)
2567                                               [mo $1,mc $2] }
2568
2569 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
2570         : oqtycon               { $1 }
2571         | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon BoxedTuple
2572                                                         (snd $2 + 1)))
2573                                        (mo $1:mc $3:(mcommas (fst $2))) }
2574         | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon UnboxedTuple
2575                                                         (snd $2 + 1)))
2576                                        (mo $1:mc $3:(mcommas (fst $2))) }
2577         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
2578                                        [mo $1,mj AnnRarrow $2,mc $3] }
2579         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mo $1,mc $2] }
2580         | '[:' ':]'             {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
2581         | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
2582                                         [mo $1,mj AnnTildehsh $2,mc $3] }
2583
2584 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
2585                                 -- These can appear in export lists
2586         : qtycon                        { $1 }
2587         | '(' qtyconsym ')'             {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2588         | '(' '~' ')'                   {% ams (sLL $1 $> $ eqTyCon_RDR)
2589                                                [mo $1,mj AnnTilde $2,mc $3] }
2590
2591 qtyconop :: { Located RdrName } -- Qualified or unqualified
2592         : qtyconsym                     { $1 }
2593         | '`' qtycon '`'                {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2594
2595 qtycon :: { Located RdrName }   -- Qualified or unqualified
2596         : QCONID                        { sL1 $1 $! mkQual tcClsName (getQCONID $1) }
2597         | PREFIXQCONSYM                 { sL1 $1 $! mkQual tcClsName (getPREFIXQCONSYM $1) }
2598         | tycon                         { $1 }
2599
2600 tycon   :: { Located RdrName }  -- Unqualified
2601         : CONID                         { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
2602
2603 qtyconsym :: { Located RdrName }
2604         : QCONSYM                       { sL1 $1 $! mkQual tcClsName (getQCONSYM $1) }
2605         | QVARSYM                       { sL1 $1 $! mkQual tcClsName (getQVARSYM $1) }
2606         | tyconsym                      { $1 }
2607
2608 -- Does not include "!", because that is used for strictness marks
2609 --               or ".", because that separates the quantified type vars from the rest
2610 tyconsym :: { Located RdrName }
2611         : CONSYM                        { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
2612         | VARSYM                        { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
2613         | '*'                           { sL1 $1 $! mkUnqual tcClsName (fsLit "*")    }
2614         | '-'                           { sL1 $1 $! mkUnqual tcClsName (fsLit "-")    }
2615
2616
2617 -----------------------------------------------------------------------------
2618 -- Operators
2619
2620 op      :: { Located RdrName }   -- used in infix decls
2621         : varop                 { $1 }
2622         | conop                 { $1 }
2623
2624 varop   :: { Located RdrName }
2625         : varsym                { $1 }
2626         | '`' varid '`'         {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2627
2628 qop     :: { LHsExpr RdrName }   -- used in sections
2629         : qvarop                { sL1 $1 $ HsVar (unLoc $1) }
2630         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2631
2632 qopm    :: { LHsExpr RdrName }   -- used in sections
2633         : qvaropm               { sL1 $1 $ HsVar (unLoc $1) }
2634         | qconop                { sL1 $1 $ HsVar (unLoc $1) }
2635
2636 qvarop :: { Located RdrName }
2637         : qvarsym               { $1 }
2638         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2639
2640 qvaropm :: { Located RdrName }
2641         : qvarsym_no_minus      { $1 }
2642         | '`' qvarid '`'        {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2643
2644 -----------------------------------------------------------------------------
2645 -- Type variables
2646
2647 tyvar   :: { Located RdrName }
2648 tyvar   : tyvarid               { $1 }
2649
2650 tyvarop :: { Located RdrName }
2651 tyvarop : '`' tyvarid '`'       {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2652         | '.'                   {% parseErrorSDoc (getLoc $1)
2653                                       (vcat [ptext (sLit "Illegal symbol '.' in type"),
2654                                              ptext (sLit "Perhaps you intended to use RankNTypes or a similar language"),
2655                                              ptext (sLit "extension to enable explicit-forall syntax: forall <tvs>. <type>")])
2656                                 }
2657
2658 tyvarid :: { Located RdrName }
2659         : VARID                 { sL1 $1 $! mkUnqual tvName (getVARID $1) }
2660         | special_id            { sL1 $1 $! mkUnqual tvName (unLoc $1) }
2661         | 'unsafe'              { sL1 $1 $! mkUnqual tvName (fsLit "unsafe") }
2662         | 'safe'                { sL1 $1 $! mkUnqual tvName (fsLit "safe") }
2663         | 'interruptible'       { sL1 $1 $! mkUnqual tvName (fsLit "interruptible") }
2664
2665 -----------------------------------------------------------------------------
2666 -- Variables
2667
2668 var     :: { Located RdrName }
2669         : varid                 { $1 }
2670         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2671
2672 qvar    :: { Located RdrName }
2673         : qvarid                { $1 }
2674         | '(' varsym ')'        {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2675         | '(' qvarsym1 ')'      {% ams (sLL $1 $> (unLoc $2)) [mo $1,mc $3] }
2676 -- We've inlined qvarsym here so that the decision about
2677 -- whether it's a qvar or a var can be postponed until
2678 -- *after* we see the close paren.
2679
2680 qvarid :: { Located RdrName }
2681         : varid                 { $1 }
2682         | QVARID                { sL1 $1 $! mkQual varName (getQVARID $1) }
2683         | PREFIXQVARSYM         { sL1 $1 $! mkQual varName (getPREFIXQVARSYM $1) }
2684
2685 -- Note that 'role' and 'family' get lexed separately regardless of
2686 -- the use of extensions. However, because they are listed here, this
2687 -- is OK and they can be used as normal varids.
2688 varid :: { Located RdrName }
2689         : VARID                 { sL1 $1 $! mkUnqual varName (getVARID $1) }
2690         | special_id            { sL1 $1 $! mkUnqual varName (unLoc $1) }
2691         | 'unsafe'              { sL1 $1 $! mkUnqual varName (fsLit "unsafe") }
2692         | 'safe'                { sL1 $1 $! mkUnqual varName (fsLit "safe") }
2693         | 'interruptible'       { sL1 $1 $! mkUnqual varName (fsLit "interruptible") }
2694         | 'forall'              { sL1 $1 $! mkUnqual varName (fsLit "forall") }
2695         | 'family'              { sL1 $1 $! mkUnqual varName (fsLit "family") }
2696         | 'role'                { sL1 $1 $! mkUnqual varName (fsLit "role") }
2697
2698 qvarsym :: { Located RdrName }
2699         : varsym                { $1 }
2700         | qvarsym1              { $1 }
2701
2702 qvarsym_no_minus :: { Located RdrName }
2703         : varsym_no_minus       { $1 }
2704         | qvarsym1              { $1 }
2705
2706 qvarsym1 :: { Located RdrName }
2707 qvarsym1 : QVARSYM              { sL1 $1 $ mkQual varName (getQVARSYM $1) }
2708
2709 varsym :: { Located RdrName }
2710         : varsym_no_minus       { $1 }
2711         | '-'                   { sL1 $1 $ mkUnqual varName (fsLit "-") }
2712
2713 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
2714         : VARSYM                { sL1 $1 $ mkUnqual varName (getVARSYM $1) }
2715         | special_sym           { sL1 $1 $ mkUnqual varName (unLoc $1) }
2716
2717
2718 -- These special_ids are treated as keywords in various places,
2719 -- but as ordinary ids elsewhere.   'special_id' collects all these
2720 -- except 'unsafe', 'interruptible', 'forall', 'family', and 'role',
2721 -- whose treatment differs depending on context
2722 special_id :: { Located FastString }
2723 special_id
2724         : 'as'                  { sL1 $1 (fsLit "as") }
2725         | 'qualified'           { sL1 $1 (fsLit "qualified") }
2726         | 'hiding'              { sL1 $1 (fsLit "hiding") }
2727         | 'export'              { sL1 $1 (fsLit "export") }
2728         | 'label'               { sL1 $1 (fsLit "label")  }
2729         | 'dynamic'             { sL1 $1 (fsLit "dynamic") }
2730         | 'stdcall'             { sL1 $1 (fsLit "stdcall") }
2731         | 'ccall'               { sL1 $1 (fsLit "ccall") }
2732         | 'capi'                { sL1 $1 (fsLit "capi") }
2733         | 'prim'                { sL1 $1 (fsLit "prim") }
2734         | 'javascript'          { sL1 $1 (fsLit "javascript") }
2735         | 'group'               { sL1 $1 (fsLit "group") }
2736
2737 special_sym :: { Located FastString }
2738 special_sym : '!'       { sL1 $1 (fsLit "!") }
2739             | '.'       { sL1 $1 (fsLit ".") }
2740             | '*'       { sL1 $1 (fsLit "*") }
2741
2742 -----------------------------------------------------------------------------
2743 -- Data constructors
2744
2745 qconid :: { Located RdrName }   -- Qualified or unqualified
2746         : conid                 { $1 }
2747         | QCONID                { sL1 $1 $! mkQual dataName (getQCONID $1) }
2748         | PREFIXQCONSYM         { sL1 $1 $! mkQual dataName (getPREFIXQCONSYM $1) }
2749
2750 conid   :: { Located RdrName }
2751         : CONID                 { sL1 $1 $ mkUnqual dataName (getCONID $1) }
2752
2753 qconsym :: { Located RdrName }  -- Qualified or unqualified
2754         : consym                { $1 }
2755         | QCONSYM               { sL1 $1 $ mkQual dataName (getQCONSYM $1) }
2756
2757 consym :: { Located RdrName }
2758         : CONSYM                { sL1 $1 $ mkUnqual dataName (getCONSYM $1) }
2759
2760         -- ':' means only list cons
2761         | ':'                   { sL1 $1 $ consDataCon_RDR }
2762
2763
2764 -----------------------------------------------------------------------------
2765 -- Literals
2766
2767 literal :: { Located HsLit }
2768         : CHAR              { sL1 $1 $ HsChar       (getCHARs $1) $ getCHAR $1 }
2769         | STRING            { sL1 $1 $ HsString     (getSTRINGs $1)
2770                                                    $ getSTRING $1 }
2771         | PRIMINTEGER       { sL1 $1 $ HsIntPrim    (getPRIMINTEGERs $1)
2772                                                    $ getPRIMINTEGER $1 }
2773         | PRIMWORD          { sL1 $1 $ HsWordPrim   (getPRIMWORDs $1)
2774                                                    $ getPRIMWORD $1 }
2775         | PRIMCHAR          { sL1 $1 $ HsCharPrim   (getPRIMCHARs $1)
2776                                                    $ getPRIMCHAR $1 }
2777         | PRIMSTRING        { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
2778                                                    $ getPRIMSTRING $1 }
2779         | PRIMFLOAT         { sL1 $1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
2780         | PRIMDOUBLE        { sL1 $1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
2781
2782 -----------------------------------------------------------------------------
2783 -- Layout
2784
2785 close :: { () }
2786         : vccurly               { () } -- context popped in lexer.
2787         | error                 {% popContext }
2788
2789 -----------------------------------------------------------------------------
2790 -- Miscellaneous (mostly renamings)
2791
2792 modid   :: { Located ModuleName }
2793         : CONID                 { sL1 $1 $ mkModuleNameFS (getCONID $1) }
2794         | QCONID                { sL1 $1 $ let (mod,c) = getQCONID $1 in
2795                                   mkModuleNameFS
2796                                    (mkFastString
2797                                      (unpackFS mod ++ '.':unpackFS c))
2798                                 }
2799
2800 commas :: { ([SrcSpan],Int) }   -- One or more commas
2801         : commas ','             { ((fst $1)++[gl $2],snd $1 + 1) }
2802         | ','                    { ([gl $1],1) }
2803
2804 -----------------------------------------------------------------------------
2805 -- Documentation comments
2806
2807 docnext :: { LHsDocString }
2808   : DOCNEXT {% return (sL1 $1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
2809
2810 docprev :: { LHsDocString }
2811   : DOCPREV {% return (sL1 $1 (HsDocString (mkFastString (getDOCPREV $1)))) }
2812
2813 docnamed :: { Located (String, HsDocString) }
2814   : DOCNAMED {%
2815       let string = getDOCNAMED $1
2816           (name, rest) = break isSpace string
2817       in return (sL1 $1 (name, HsDocString (mkFastString rest))) }
2818
2819 docsection :: { Located (Int, HsDocString) }
2820   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
2821         return (sL1 $1 (n, HsDocString (mkFastString doc))) }
2822
2823 moduleheader :: { Maybe LHsDocString }
2824         : DOCNEXT {% let string = getDOCNEXT $1 in
2825                      return (Just (sL1 $1 (HsDocString (mkFastString string)))) }
2826
2827 maybe_docprev :: { Maybe LHsDocString }
2828         : docprev                       { Just $1 }
2829         | {- empty -}                   { Nothing }
2830
2831 maybe_docnext :: { Maybe LHsDocString }
2832         : docnext                       { Just $1 }
2833         | {- empty -}                   { Nothing }
2834
2835 {
2836 happyError :: P a
2837 happyError = srcParseFail
2838
2839 getVARID        (L _ (ITvarid    x)) = x
2840 getCONID        (L _ (ITconid    x)) = x
2841 getVARSYM       (L _ (ITvarsym   x)) = x
2842 getCONSYM       (L _ (ITconsym   x)) = x
2843 getQVARID       (L _ (ITqvarid   x)) = x
2844 getQCONID       (L _ (ITqconid   x)) = x
2845 getQVARSYM      (L _ (ITqvarsym  x)) = x
2846 getQCONSYM      (L _ (ITqconsym  x)) = x
2847 getPREFIXQVARSYM (L _ (ITprefixqvarsym  x)) = x
2848 getPREFIXQCONSYM (L _ (ITprefixqconsym  x)) = x
2849 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
2850 getCHAR         (L _ (ITchar   _ x)) = x
2851 getSTRING       (L _ (ITstring _ x)) = x
2852 getINTEGER      (L _ (ITinteger _ x)) = x
2853 getRATIONAL     (L _ (ITrational x)) = x
2854 getPRIMCHAR     (L _ (ITprimchar _ x)) = x
2855 getPRIMSTRING   (L _ (ITprimstring _ x)) = x
2856 getPRIMINTEGER  (L _ (ITprimint  _ x)) = x
2857 getPRIMWORD     (L _ (ITprimword _ x)) = x
2858 getPRIMFLOAT    (L _ (ITprimfloat x)) = x
2859 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
2860 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
2861 getTH_ID_TY_SPLICE (L _ (ITidTyEscape x)) = x
2862 getINLINE       (L _ (ITinline_prag inl conl)) = (inl,conl)
2863 getSPEC_INLINE  (L _ (ITspec_inline_prag True))  = (Inline,  FunLike)
2864 getSPEC_INLINE  (L _ (ITspec_inline_prag False)) = (NoInline,FunLike)
2865
2866 getDOCNEXT (L _ (ITdocCommentNext x)) = x
2867 getDOCPREV (L _ (ITdocCommentPrev x)) = x
2868 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
2869 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
2870
2871 getCHARs        (L _ (ITchar       src _)) = src
2872 getSTRINGs      (L _ (ITstring     src _)) = src
2873 getINTEGERs     (L _ (ITinteger    src _)) = src
2874 getPRIMCHARs    (L _ (ITprimchar   src _)) = src
2875 getPRIMSTRINGs  (L _ (ITprimstring src _)) = src
2876 getPRIMINTEGERs (L _ (ITprimint    src _)) = src
2877 getPRIMWORDs    (L _ (ITprimword   src _)) = src
2878
2879
2880
2881 getSCC :: Located Token -> P FastString
2882 getSCC lt = do let s = getSTRING lt
2883                    err = "Spaces are not allowed in SCCs"
2884                -- We probably actually want to be more restrictive than this
2885                if ' ' `elem` unpackFS s
2886                    then failSpanMsgP (getLoc lt) (text err)
2887                    else return s
2888
2889 -- Utilities for combining source spans
2890 comb2 :: Located a -> Located b -> SrcSpan
2891 comb2 a b = a `seq` b `seq` combineLocs a b
2892
2893 comb3 :: Located a -> Located b -> Located c -> SrcSpan
2894 comb3 a b c = a `seq` b `seq` c `seq`
2895     combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
2896
2897 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
2898 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
2899     (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
2900                 combineSrcSpans (getLoc c) (getLoc d))
2901
2902 -- strict constructor version:
2903 {-# INLINE sL #-}
2904 sL :: SrcSpan -> a -> Located a
2905 sL span a = span `seq` a `seq` L span a
2906
2907 -- replaced last 3 CPP macros in this file
2908 {-# INLINE sL0 #-}
2909 sL0 = L noSrcSpan       -- #define L0   L noSrcSpan
2910
2911 {-# INLINE sL1 #-}
2912 sL1 x = sL (getLoc x)   -- #define sL1   sL (getLoc $1)
2913
2914 {-# INLINE sLL #-}
2915 sLL x y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
2916
2917 -- Make a source location for the file.  We're a bit lazy here and just
2918 -- make a point SrcSpan at line 1, column 0.  Strictly speaking we should
2919 -- try to find the span of the whole file (ToDo).
2920 fileSrcSpan :: P SrcSpan
2921 fileSrcSpan = do
2922   l <- getSrcLoc;
2923   let loc = mkSrcLoc (srcLocFile l) 1 1;
2924   return (mkSrcSpan loc loc)
2925
2926 -- Hint about the MultiWayIf extension
2927 hintMultiWayIf :: SrcSpan -> P ()
2928 hintMultiWayIf span = do
2929   mwiEnabled <- liftM ((Opt_MultiWayIf `xopt`) . dflags) getPState
2930   unless mwiEnabled $ parseErrorSDoc span $
2931     text "Multi-way if-expressions need MultiWayIf turned on"
2932
2933 -- Hint about if usage for beginners
2934 hintIf :: SrcSpan -> String -> P (LHsExpr RdrName)
2935 hintIf span msg = do
2936   mwiEnabled <- liftM ((Opt_MultiWayIf `xopt`) . dflags) getPState
2937   if mwiEnabled
2938     then parseErrorSDoc span $ text $ "parse error in if statement"
2939     else parseErrorSDoc span $ text $ "parse error in if statement: "++msg
2940
2941 -- Hint about explicit-forall, assuming UnicodeSyntax is on
2942 hintExplicitForall :: SrcSpan -> P ()
2943 hintExplicitForall span = do
2944     forall      <- extension explicitForallEnabled
2945     rulePrag    <- extension inRulePrag
2946     unless (forall || rulePrag) $ parseErrorSDoc span $ vcat
2947       [ text "Illegal symbol '\x2200' in type" -- U+2200 FOR ALL
2948       , text "Perhaps you intended to use RankNTypes or a similar language"
2949       , text "extension to enable explicit-forall syntax: \x2200 <tvs>. <type>"
2950       ]
2951
2952 namedWildcardsEnabled :: P Bool
2953 namedWildcardsEnabled = liftM ((Opt_NamedWildcards `xopt`) . dflags) getPState
2954
2955 {-
2956 %************************************************************************
2957 %*                                                                      *
2958         Helper functions for generating annotations in the parser
2959 %*                                                                      *
2960 %************************************************************************
2961
2962 For the general principles of the following routines, see Note [Api annotations]
2963 in ApiAnnotation.hs
2964
2965 -}
2966
2967 -- |Encapsulated call to addAnnotation, requiring only the SrcSpan of
2968 -- the AST element the annotation belongs to
2969 type AddAnn = (SrcSpan -> P ())
2970
2971 -- |Construct an AddAnn from the annotation keyword and the location
2972 -- of the keyword
2973 mj :: AnnKeywordId -> Located e -> AddAnn
2974 mj a l = (\s -> addAnnotation s a (gl l))
2975
2976
2977 gl = getLoc
2978
2979 -- |Add an annotation to the located element, and return the located
2980 -- element as a pass through
2981 aa :: Located a -> (AnnKeywordId,Located c) -> P (Located a)
2982 aa a@(L l _) (b,s) = addAnnotation l b (gl s) >> return a
2983
2984 -- |Add an annotation to a located element resulting from a monadic action
2985 am :: P (Located a) -> (AnnKeywordId, Located b) -> P (Located a)
2986 am a (b,s) = do
2987   av@(L l _) <- a
2988   addAnnotation l b (gl s)
2989   return av
2990
2991 -- |Add a list of AddAnns to the given AST element
2992 ams :: Located a -> [AddAnn] -> P (Located a)
2993 ams a@(L l _) bs = mapM_ (\a -> a l) bs >> return a
2994
2995
2996 -- |Add a list of AddAnns to the given AST element, where the AST element is the
2997 --  result of a monadic action
2998 amms :: P (Located a) -> [AddAnn] -> P (Located a)
2999 amms a bs = do
3000   av@(L l _) <- a
3001   (mapM_ (\a -> a l) bs) >> return av
3002
3003 -- |Add a list of AddAnns to the AST element, and return the element as a
3004 --  OrdList
3005 amsu :: Located a -> [AddAnn] -> P (OrdList (Located a))
3006 amsu a@(L l _) bs = (mapM_ (\a -> a l) bs) >> return (unitOL a)
3007
3008 -- |Synonyms for AddAnn versions of AnnOpen and AnnClose
3009 mo,mc :: Located Token -> SrcSpan -> P ()
3010 mo ll = mj AnnOpen ll
3011 mc ll = mj AnnClose ll
3012
3013 -- |Given a list of the locations of commas, provide a [AddAnn] with an AnnComma
3014 --  entry for each SrcSpan
3015 mcommas :: [SrcSpan] -> [AddAnn]
3016 mcommas ss = map (\s -> mj AnnComma (L s ())) ss
3017
3018 -- |Add the annotation to an AST element wrapped in a Just
3019 ajl :: Located (Maybe (Located a)) -> AnnKeywordId -> SrcSpan
3020  -> P (Located (Maybe (Located a)))
3021 ajl a@(L _ (Just (L l _))) b s = addAnnotation l b s >> return a
3022
3023 -- |Add all [AddAnn] to an AST element wrapped in a Just
3024 aljs :: Located (Maybe (Located a)) -> [AddAnn]
3025   -> P (Located (Maybe (Located a)))
3026 aljs a@(L _ (Just (L l _))) bs = (mapM_ (\a -> a l) bs) >> return a
3027
3028 -- |Add all [AddAnn] to an AST element wrapped in a Just
3029 ajs a@(Just (L l _)) bs = (mapM_ (\a -> a l) bs) >> return a
3030
3031 -- |Get the location of the last element of a OrdList, or noLoc
3032 oll :: OrdList (Located a) -> SrcSpan
3033 oll l = case fromOL l of
3034          [] -> noSrcSpan
3035          xs -> getLoc (last xs)
3036
3037 -- |Add a semicolon annotation in the right place in a list. If the
3038 -- leading list is empty, add it to the tail
3039 asl :: [Located a] -> Located b -> Located a -> P()
3040 asl [] (L ls _) (L l _) = addAnnotation l                  AnnSemi ls
3041 asl (x:_xs) (L ls _) _x = addAnnotation (getLoc x) AnnSemi ls
3042
3043 }