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