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