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