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