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