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