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