Refactor HsDecls again, to put family instances in InstDecl
[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         | inst_decl                             { unitOL (L1 (InstD (unLoc $1))) }
571         | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
572         | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
573         | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
574         | '{-# DEPRECATED' deprecations '#-}'   { $2 }
575         | '{-# WARNING' warnings '#-}'          { $2 }
576         | '{-# RULES' rules '#-}'               { $2 }
577         | '{-# VECTORISE_SCALAR' qvar '#-}'     { unitOL $ LL $ VectD (HsVect       $2 Nothing) }
578         | '{-# VECTORISE' qvar '=' exp '#-}'    { unitOL $ LL $ VectD (HsVect       $2 (Just $4)) }
579         | '{-# NOVECTORISE' qvar '#-}'          { unitOL $ LL $ VectD (HsNoVect     $2) }
580         | '{-# VECTORISE' 'type' gtycon '#-}'     
581                                                 { unitOL $ LL $ 
582                                                     VectD (HsVectTypeIn False $3 Nothing) }
583         | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'     
584                                                 { unitOL $ LL $ 
585                                                     VectD (HsVectTypeIn True $3 Nothing) }
586         | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'     
587                                                 { unitOL $ LL $ 
588                                                     VectD (HsVectTypeIn False $3 (Just $5)) }
589         | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'     
590                                                 { unitOL $ LL $ 
591                                                     VectD (HsVectTypeIn True $3 (Just $5)) }
592         | '{-# VECTORISE' 'class' gtycon '#-}'  { unitOL $ LL $ VectD (HsVectClassIn $3) }
593         | '{-# VECTORISE_SCALAR' 'instance' type '#-}'     
594                                                 { unitOL $ LL $ VectD (HsVectInstIn $3) }
595         | annotation { unitOL $1 }
596         | decl                                  { unLoc $1 }
597
598         -- Template Haskell Extension
599         -- The $(..) form is one possible form of infixexp
600         -- but we treat an arbitrary expression just as if 
601         -- it had a $(..) wrapped around it
602         | infixexp                              { unitOL (LL $ mkTopSpliceDecl $1) } 
603
604 -- Type classes
605 --
606 cl_decl :: { LTyClDecl RdrName }
607         : 'class' tycl_hdr fds where_cls        {% mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 $4 }
608
609 -- Type declarations (toplevel)
610 --
611 ty_decl :: { LTyClDecl RdrName }
612            -- ordinary type synonyms
613         : 'type' type '=' ctypedoc
614                 -- Note ctype, not sigtype, on the right of '='
615                 -- We allow an explicit for-all but we don't insert one
616                 -- in   type Foo a = (b,b)
617                 -- Instead we just say b is out of scope
618                 --
619                 -- Note the use of type for the head; this allows
620                 -- infix type constructors to be declared 
621                 {% mkTySynonym (comb2 $1 $4) False $2 $4 }
622
623            -- type family declarations
624         | 'type' 'family' type opt_kind_sig 
625                 -- Note the use of type for the head; this allows
626                 -- infix type constructors to be declared
627                 {% mkTyFamily (comb3 $1 $3 $4) TypeFamily $3 (unLoc $4) }
628
629           -- ordinary data type or newtype declaration
630         | data_or_newtype tycl_hdr constrs deriving
631                 {% mkTyData (comb4 $1 $2 $3 $4) (unLoc $1) False $2 
632                             Nothing (reverse (unLoc $3)) (unLoc $4) }
633                                    -- We need the location on tycl_hdr in case 
634                                    -- constrs and deriving are both empty
635
636           -- ordinary GADT declaration
637         | data_or_newtype tycl_hdr opt_kind_sig 
638                  gadt_constrlist
639                  deriving
640                 {% mkTyData (comb4 $1 $2 $4 $5) (unLoc $1) False $2 
641                             (unLoc $3) (unLoc $4) (unLoc $5) }
642                                    -- We need the location on tycl_hdr in case 
643                                    -- constrs and deriving are both empty
644
645           -- data/newtype family
646         | 'data' 'family' type opt_kind_sig
647                 {% mkTyFamily (comb3 $1 $2 $4) DataFamily $3 (unLoc $4) }
648
649 inst_decl :: { LInstDecl RdrName }
650         : 'instance' inst_type where_inst
651                  { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
652                    in L (comb3 $1 $2 $3) (ClsInstDecl $2 binds sigs ats) }
653
654            -- type instance declarations
655         | 'type' 'instance' type '=' ctype
656                 -- Note the use of type for the head; this allows
657                 -- infix type constructors and type patterns
658                 {% do { L loc d <- mkTySynonym (comb2 $1 $5) True $3 $5
659                       ; return (L loc (FamInstDecl d)) } }
660
661           -- data/newtype instance declaration
662         | data_or_newtype 'instance' tycl_hdr constrs deriving
663                 {% do { L loc d <- mkTyData (comb4 $1 $3 $4 $5) (unLoc $1) True $3
664                                       Nothing (reverse (unLoc $4)) (unLoc $5)
665                       ; return (L loc (FamInstDecl d)) } }
666
667           -- GADT instance declaration
668         | data_or_newtype 'instance' tycl_hdr opt_kind_sig 
669                  gadt_constrlist
670                  deriving
671                 {% do { L loc d <- mkTyData (comb4 $1 $3 $5 $6) (unLoc $1) True $3
672                                             (unLoc $4) (unLoc $5) (unLoc $6)
673                       ; return (L loc (FamInstDecl d)) } }
674         
675 -- Associated type family declarations
676 --
677 -- * They have a different syntax than on the toplevel (no family special
678 --   identifier).
679 --
680 -- * They also need to be separate from instances; otherwise, data family
681 --   declarations without a kind signature cause parsing conflicts with empty
682 --   data declarations. 
683 --
684 at_decl_cls :: { LTyClDecl RdrName }
685            -- type family declarations
686         : 'type' type opt_kind_sig
687                 -- Note the use of type for the head; this allows
688                 -- infix type constructors to be declared
689                 {% mkTyFamily (comb3 $1 $2 $3) TypeFamily $2 (unLoc $3) }
690
691            -- default type instance
692         | 'type' type '=' ctype
693                 -- Note the use of type for the head; this allows
694                 -- infix type constructors and type patterns
695                 {% mkTySynonym (comb2 $1 $4) True $2 $4 }
696
697           -- data/newtype family declaration
698         | 'data' type opt_kind_sig
699                 {% mkTyFamily (comb3 $1 $2 $3) DataFamily $2 (unLoc $3) }
700
701 -- Associated type instances
702 --
703 at_decl_inst :: { LTyClDecl RdrName }
704            -- type instance declarations
705         : 'type' type '=' ctype
706                 -- Note the use of type for the head; this allows
707                 -- infix type constructors and type patterns
708                 {% mkTySynonym (comb2 $1 $4) True $2 $4 }
709
710         -- data/newtype instance declaration
711         | data_or_newtype tycl_hdr constrs deriving
712                 {% mkTyData (comb4 $1 $2 $3 $4) (unLoc $1) True $2 
713                             Nothing (reverse (unLoc $3)) (unLoc $4) }
714
715         -- GADT instance declaration
716         | data_or_newtype tycl_hdr opt_kind_sig 
717                  gadt_constrlist
718                  deriving
719                 {% mkTyData (comb4 $1 $2 $4 $5) (unLoc $1) True $2 
720                             (unLoc $3) (unLoc $4) (unLoc $5) }
721
722 data_or_newtype :: { Located NewOrData }
723         : 'data'        { L1 DataType }
724         | 'newtype'     { L1 NewType }
725
726 opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) }
727         :                               { noLoc Nothing }
728         | '::' kind                     { LL (Just $2) }
729
730 -- tycl_hdr parses the header of a class or data type decl,
731 -- which takes the form
732 --      T a b
733 --      Eq a => T a
734 --      (Eq a, Ord b) => T a b
735 --      T Int [a]                       -- for associated types
736 -- Rather a lot of inlining here, else we get reduce/reduce errors
737 tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
738         : context '=>' type             { LL (Just $1, $3) }
739         | type                          { L1 (Nothing, $1) }
740
741 -----------------------------------------------------------------------------
742 -- Stand-alone deriving
743
744 -- Glasgow extension: stand-alone deriving declarations
745 stand_alone_deriving :: { LDerivDecl RdrName }
746         : 'deriving' 'instance' inst_type { LL (DerivDecl $3) }
747
748 -----------------------------------------------------------------------------
749 -- Nested declarations
750
751 -- Declaration in class bodies
752 --
753 decl_cls  :: { Located (OrdList (LHsDecl RdrName)) }
754 decl_cls  : at_decl_cls                 { LL (unitOL (L1 (TyClD (unLoc $1)))) }
755           | decl                        { $1 }
756
757           -- A 'default' signature used with the generic-programming extension
758           | 'default' infixexp '::' sigtypedoc
759                     {% do { (TypeSig l ty) <- checkValSig $2 $4
760                           ; return (LL $ unitOL (LL $ SigD (GenericSig l ty))) } }
761
762 decls_cls :: { Located (OrdList (LHsDecl RdrName)) }    -- Reversed
763           : decls_cls ';' decl_cls      { LL (unLoc $1 `appOL` unLoc $3) }
764           | decls_cls ';'               { LL (unLoc $1) }
765           | decl_cls                    { $1 }
766           | {- empty -}                 { noLoc nilOL }
767
768
769 decllist_cls
770         :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
771         : '{'         decls_cls '}'     { LL (unLoc $2) }
772         |     vocurly decls_cls close   { $2 }
773
774 -- Class body
775 --
776 where_cls :: { Located (OrdList (LHsDecl RdrName)) }    -- Reversed
777                                 -- No implicit parameters
778                                 -- May have type declarations
779         : 'where' decllist_cls          { LL (unLoc $2) }
780         | {- empty -}                   { noLoc nilOL }
781
782 -- Declarations in instance bodies
783 --
784 decl_inst  :: { Located (OrdList (LHsDecl RdrName)) }
785 decl_inst  : at_decl_inst               { LL (unitOL (L1 (TyClD (unLoc $1)))) }
786            | decl                       { $1 }
787
788 decls_inst :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
789            : decls_inst ';' decl_inst   { LL (unLoc $1 `appOL` unLoc $3) }
790            | decls_inst ';'             { LL (unLoc $1) }
791            | decl_inst                  { $1 }
792            | {- empty -}                { noLoc nilOL }
793
794 decllist_inst 
795         :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
796         : '{'         decls_inst '}'    { LL (unLoc $2) }
797         |     vocurly decls_inst close  { $2 }
798
799 -- Instance body
800 --
801 where_inst :: { Located (OrdList (LHsDecl RdrName)) }   -- Reversed
802                                 -- No implicit parameters
803                                 -- May have type declarations
804         : 'where' decllist_inst         { LL (unLoc $2) }
805         | {- empty -}                   { noLoc nilOL }
806
807 -- Declarations in binding groups other than classes and instances
808 --
809 decls   :: { Located (OrdList (LHsDecl RdrName)) }      
810         : decls ';' decl                { let { this = unLoc $3;
811                                     rest = unLoc $1;
812                                     these = rest `appOL` this }
813                               in rest `seq` this `seq` these `seq`
814                                     LL these }
815         | decls ';'                     { LL (unLoc $1) }
816         | decl                          { $1 }
817         | {- empty -}                   { noLoc nilOL }
818
819 decllist :: { Located (OrdList (LHsDecl RdrName)) }
820         : '{'            decls '}'      { LL (unLoc $2) }
821         |     vocurly    decls close    { $2 }
822
823 -- Binding groups other than those of class and instance declarations
824 --
825 binds   ::  { Located (HsLocalBinds RdrName) }          -- May have implicit parameters
826                                                 -- No type declarations
827         : decllist                      { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
828         | '{'            dbinds '}'     { LL (HsIPBinds (IPBinds (unLoc $2) emptyTcEvBinds)) }
829         |     vocurly    dbinds close   { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyTcEvBinds)) }
830
831 wherebinds :: { Located (HsLocalBinds RdrName) }        -- May have implicit parameters
832                                                 -- No type declarations
833         : 'where' binds                 { LL (unLoc $2) }
834         | {- empty -}                   { noLoc emptyLocalBinds }
835
836
837 -----------------------------------------------------------------------------
838 -- Transformation Rules
839
840 rules   :: { OrdList (LHsDecl RdrName) }
841         :  rules ';' rule                       { $1 `snocOL` $3 }
842         |  rules ';'                            { $1 }
843         |  rule                                 { unitOL $1 }
844         |  {- empty -}                          { nilOL }
845
846 rule    :: { LHsDecl RdrName }
847         : STRING activation rule_forall infixexp '=' exp
848              { LL $ RuleD (HsRule (getSTRING $1) 
849                                   ($2 `orElse` AlwaysActive) 
850                                   $3 $4 placeHolderNames $6 placeHolderNames) }
851
852 activation :: { Maybe Activation } 
853         : {- empty -}                           { Nothing }
854         | explicit_activation                   { Just $1 }
855
856 explicit_activation :: { Activation }  -- In brackets
857         : '[' INTEGER ']'               { ActiveAfter  (fromInteger (getINTEGER $2)) }
858         | '[' '~' INTEGER ']'           { ActiveBefore (fromInteger (getINTEGER $3)) }
859
860 rule_forall :: { [RuleBndr RdrName] }
861         : 'forall' rule_var_list '.'            { $2 }
862         | {- empty -}                           { [] }
863
864 rule_var_list :: { [RuleBndr RdrName] }
865         : rule_var                              { [$1] }
866         | rule_var rule_var_list                { $1 : $2 }
867
868 rule_var :: { RuleBndr RdrName }
869         : varid                                 { RuleBndr $1 }
870         | '(' varid '::' ctype ')'              { RuleBndrSig $2 $4 }
871
872 -----------------------------------------------------------------------------
873 -- Warnings and deprecations (c.f. rules)
874
875 warnings :: { OrdList (LHsDecl RdrName) }
876         : warnings ';' warning          { $1 `appOL` $3 }
877         | warnings ';'                  { $1 }
878         | warning                               { $1 }
879         | {- empty -}                           { nilOL }
880
881 -- SUP: TEMPORARY HACK, not checking for `module Foo'
882 warning :: { OrdList (LHsDecl RdrName) }
883         : namelist strings
884                 { toOL [ LL $ WarningD (Warning n (WarningTxt $ unLoc $2))
885                        | n <- unLoc $1 ] }
886
887 deprecations :: { OrdList (LHsDecl RdrName) }
888         : deprecations ';' deprecation          { $1 `appOL` $3 }
889         | deprecations ';'                      { $1 }
890         | deprecation                           { $1 }
891         | {- empty -}                           { nilOL }
892
893 -- SUP: TEMPORARY HACK, not checking for `module Foo'
894 deprecation :: { OrdList (LHsDecl RdrName) }
895         : namelist strings
896                 { toOL [ LL $ WarningD (Warning n (DeprecatedTxt $ unLoc $2))
897                        | n <- unLoc $1 ] }
898
899 strings :: { Located [FastString] }
900     : STRING { L1 [getSTRING $1] }
901     | '[' stringlist ']' { LL $ fromOL (unLoc $2) }
902
903 stringlist :: { Located (OrdList FastString) }
904     : stringlist ',' STRING { LL (unLoc $1 `snocOL` getSTRING $3) }
905     | STRING                { LL (unitOL (getSTRING $1)) }
906
907 -----------------------------------------------------------------------------
908 -- Annotations
909 annotation :: { LHsDecl RdrName }
910     : '{-# ANN' name_var aexp '#-}'      { LL (AnnD $ HsAnnotation (ValueAnnProvenance (unLoc $2)) $3) }
911     | '{-# ANN' 'type' tycon aexp '#-}'  { LL (AnnD $ HsAnnotation (TypeAnnProvenance (unLoc $3)) $4) }
912     | '{-# ANN' 'module' aexp '#-}'      { LL (AnnD $ HsAnnotation ModuleAnnProvenance $3) }
913
914
915 -----------------------------------------------------------------------------
916 -- Foreign import and export declarations
917
918 fdecl :: { LHsDecl RdrName }
919 fdecl : 'import' callconv safety fspec
920                 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
921       | 'import' callconv        fspec          
922                 {% do { d <- mkImport $2 PlaySafe (unLoc $3);
923                         return (LL d) } }
924       | 'export' callconv fspec
925                 {% mkExport $2 (unLoc $3) >>= return.LL }
926
927 callconv :: { CCallConv }
928           : 'stdcall'                   { StdCallConv }
929           | 'ccall'                     { CCallConv   }
930           | 'capi'                      { CApiConv    }
931           | 'prim'                      { PrimCallConv}
932
933 safety :: { Safety }
934         : 'unsafe'                      { PlayRisky }
935         | 'safe'                        { PlaySafe }
936         | 'interruptible'               { PlayInterruptible }
937
938 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
939        : STRING var '::' sigtypedoc     { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
940        |        var '::' sigtypedoc     { LL (noLoc nilFS, $1, $3) }
941          -- if the entity string is missing, it defaults to the empty string;
942          -- the meaning of an empty entity string depends on the calling
943          -- convention
944
945 -----------------------------------------------------------------------------
946 -- Type signatures
947
948 opt_sig :: { Maybe (LHsType RdrName) }
949         : {- empty -}                   { Nothing }
950         | '::' sigtype                  { Just $2 }
951
952 opt_asig :: { Maybe (LHsType RdrName) }
953         : {- empty -}                   { Nothing }
954         | '::' atype                    { Just $2 }
955
956 sigtype :: { LHsType RdrName }          -- Always a HsForAllTy,
957                                         -- to tell the renamer where to generalise
958         : ctype                         { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
959         -- Wrap an Implicit forall if there isn't one there already
960
961 sigtypedoc :: { LHsType RdrName }       -- Always a HsForAllTy
962         : ctypedoc                      { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
963         -- Wrap an Implicit forall if there isn't one there already
964
965 sig_vars :: { Located [Located RdrName] }
966          : sig_vars ',' var             { LL ($3 : unLoc $1) }
967          | var                          { L1 [$1] }
968
969 sigtypes1 :: { [LHsType RdrName] }      -- Always HsForAllTys
970         : sigtype                       { [ $1 ] }
971         | sigtype ',' sigtypes1         { $1 : $3 }
972
973 -----------------------------------------------------------------------------
974 -- Types
975
976 infixtype :: { LHsType RdrName }
977         : btype qtyconop type         { LL $ mkHsOpTy $1 $2 $3 }
978         | btype tyvarop  type    { LL $ mkHsOpTy $1 $2 $3 }
979
980 strict_mark :: { Located HsBang }
981         : '!'                           { L1 HsStrict }
982         | '{-# UNPACK' '#-}' '!'        { LL HsUnpack }
983         | '{-# NOUNPACK' '#-}' '!'      { LL HsNoUnpack }
984
985 -- A ctype is a for-all type
986 ctype   :: { LHsType RdrName }
987         : 'forall' tv_bndrs '.' ctype   { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
988         | context '=>' ctype            { LL $ mkImplicitHsForAllTy   $1 $3 }
989         -- A type of form (context => type) is an *implicit* HsForAllTy
990         | ipvar '::' type               { LL (HsIParamTy (unLoc $1) $3) }
991         | type                          { $1 }
992
993 ----------------------
994 -- Notes for 'ctypedoc'
995 -- It would have been nice to simplify the grammar by unifying `ctype` and 
996 -- ctypedoc` into one production, allowing comments on types everywhere (and
997 -- rejecting them after parsing, where necessary).  This is however not possible
998 -- since it leads to ambiguity. The reason is the support for comments on record
999 -- fields: 
1000 --         data R = R { field :: Int -- ^ comment on the field }
1001 -- If we allow comments on types here, it's not clear if the comment applies
1002 -- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
1003
1004 ctypedoc :: { LHsType RdrName }
1005         : 'forall' tv_bndrs '.' ctypedoc        { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
1006         | context '=>' ctypedoc         { LL $ mkImplicitHsForAllTy   $1 $3 }
1007         -- A type of form (context => type) is an *implicit* HsForAllTy
1008         | ipvar '::' type               { LL (HsIParamTy (unLoc $1) $3) }
1009         | typedoc                       { $1 }
1010
1011 ----------------------
1012 -- Notes for 'context'
1013 -- We parse a context as a btype so that we don't get reduce/reduce
1014 -- errors in ctype.  The basic problem is that
1015 --      (Eq a, Ord a)
1016 -- looks so much like a tuple type.  We can't tell until we find the =>
1017
1018 -- We have the t1 ~ t2 form both in 'context' and in type, 
1019 -- to permit an individual equational constraint without parenthesis.
1020 -- Thus for some reason we allow    f :: a~b => blah
1021 -- but not                          f :: ?x::Int => blah
1022 context :: { LHsContext RdrName }
1023         : btype '~'      btype          {% checkContext
1024                                              (LL $ HsEqTy $1 $3) }
1025         | btype                         {% checkContext $1 }
1026
1027 type :: { LHsType RdrName }
1028         : btype                         { $1 }
1029         | btype qtyconop type           { LL $ mkHsOpTy $1 $2 $3 }
1030         | btype tyvarop  type           { LL $ mkHsOpTy $1 $2 $3 }
1031         | btype '->'     ctype          { LL $ HsFunTy $1 $3 }
1032         | btype '~'      btype          { LL $ HsEqTy $1 $3 }
1033                                         -- see Note [Promotion]
1034         | btype SIMPLEQUOTE qconop type     { LL $ mkHsOpTy $1 $3 $4 }
1035         | btype SIMPLEQUOTE varop  type     { LL $ mkHsOpTy $1 $3 $4 }
1036
1037 typedoc :: { LHsType RdrName }
1038         : btype                          { $1 }
1039         | btype docprev                  { LL $ HsDocTy $1 $2 }
1040         | btype qtyconop type            { LL $ mkHsOpTy $1 $2 $3 }
1041         | btype qtyconop type docprev    { LL $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
1042         | btype tyvarop  type            { LL $ mkHsOpTy $1 $2 $3 }
1043         | btype tyvarop  type docprev    { LL $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
1044         | btype '->'     ctypedoc        { LL $ HsFunTy $1 $3 }
1045         | btype docprev '->' ctypedoc    { LL $ HsFunTy (L (comb2 $1 $2) (HsDocTy $1 $2)) $4 }
1046         | btype '~'      btype           { LL $ HsEqTy $1 $3 }
1047
1048 btype :: { LHsType RdrName }
1049         : btype atype                   { LL $ HsAppTy $1 $2 }
1050         | atype                         { $1 }
1051
1052 atype :: { LHsType RdrName }
1053         : ntgtycon                       { L1 (HsTyVar (unLoc $1)) }      -- Not including unit tuples
1054         | tyvar                          { L1 (HsTyVar (unLoc $1)) }      -- (See Note [Unit tuples])
1055         | strict_mark atype              { LL (HsBangTy (unLoc $1) $2) }  -- Constructor sigs only
1056         | '{' fielddecls '}'             {% checkRecordSyntax (LL $ HsRecTy $2) } -- Constructor sigs only
1057         | '(' ')'                        { LL $ HsTupleTy HsBoxedOrConstraintTuple []      }
1058         | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy HsBoxedOrConstraintTuple ($2:$4) }
1059         | '(#' '#)'                      { LL $ HsTupleTy HsUnboxedTuple           []      }       
1060         | '(#' comma_types1 '#)'         { LL $ HsTupleTy HsUnboxedTuple           $2      }
1061         | '[' ctype ']'                  { LL $ HsListTy  $2 }
1062         | '[:' ctype ':]'                { LL $ HsPArrTy  $2 }
1063         | '(' ctype ')'                  { LL $ HsParTy   $2 }
1064         | '(' ctype '::' kind ')'        { LL $ HsKindSig $2 $4 }
1065         | quasiquote                     { L1 (HsQuasiQuoteTy (unLoc $1)) }
1066         | '$(' exp ')'                   { LL $ mkHsSpliceTy $2 }
1067         | TH_ID_SPLICE                   { LL $ mkHsSpliceTy $ L1 $ HsVar $
1068                                            mkUnqual varName (getTH_ID_SPLICE $1) }
1069                                                       -- see Note [Promotion] for the followings
1070         | SIMPLEQUOTE qconid                          { LL $ HsTyVar $ unLoc $2 }
1071         | SIMPLEQUOTE  '(' ')'                        { LL $ HsTyVar $ getRdrName unitDataCon }
1072         | SIMPLEQUOTE  '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) }
1073         | SIMPLEQUOTE  '[' comma_types0 ']'           { LL $ HsExplicitListTy placeHolderKind $3 }
1074         | '[' ctype ',' comma_types1 ']'              { LL $ HsExplicitListTy placeHolderKind ($2 : $4) }
1075
1076 -- An inst_type is what occurs in the head of an instance decl
1077 --      e.g.  (Foo a, Gaz b) => Wibble a b
1078 -- It's kept as a single type, with a MonoDictTy at the right
1079 -- hand corner, for convenience.
1080 inst_type :: { LHsType RdrName }
1081         : sigtype                       { $1 }
1082
1083 inst_types1 :: { [LHsType RdrName] }
1084         : inst_type                     { [$1] }
1085         | inst_type ',' inst_types1     { $1 : $3 }
1086
1087 comma_types0  :: { [LHsType RdrName] }
1088         : comma_types1                  { $1 }
1089         | {- empty -}                   { [] }
1090
1091 comma_types1    :: { [LHsType RdrName] }
1092         : ctype                         { [$1] }
1093         | ctype  ',' comma_types1       { $1 : $3 }
1094
1095 tv_bndrs :: { [LHsTyVarBndr RdrName] }
1096          : tv_bndr tv_bndrs             { $1 : $2 }
1097          | {- empty -}                  { [] }
1098
1099 tv_bndr :: { LHsTyVarBndr RdrName }
1100         : tyvar                         { L1 (UserTyVar (unLoc $1) placeHolderKind) }
1101         | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) $4 placeHolderKind) }
1102
1103 fds :: { Located [Located (FunDep RdrName)] }
1104         : {- empty -}                   { noLoc [] }
1105         | '|' fds1                      { LL (reverse (unLoc $2)) }
1106
1107 fds1 :: { Located [Located (FunDep RdrName)] }
1108         : fds1 ',' fd                   { LL ($3 : unLoc $1) }
1109         | fd                            { L1 [$1] }
1110
1111 fd :: { Located (FunDep RdrName) }
1112         : varids0 '->' varids0          { L (comb3 $1 $2 $3)
1113                                            (reverse (unLoc $1), reverse (unLoc $3)) }
1114
1115 varids0 :: { Located [RdrName] }
1116         : {- empty -}                   { noLoc [] }
1117         | varids0 tyvar                 { LL (unLoc $2 : unLoc $1) }
1118
1119 -----------------------------------------------------------------------------
1120 -- Kinds
1121
1122 kind :: { LHsKind RdrName }
1123         : bkind                  { $1 }
1124         | bkind '->' kind        { LL $ HsFunTy $1 $3 }
1125
1126 bkind :: { LHsKind RdrName }
1127         : akind                  { $1 }
1128         | bkind akind            { LL $ HsAppTy $1 $2 }
1129
1130 akind :: { LHsKind RdrName }
1131         : '*'                    { L1 $ HsTyVar (nameRdrName liftedTypeKindTyConName) }
1132         | '(' kind ')'           { LL $ HsParTy $2 }
1133         | pkind                  { $1 }
1134
1135 pkind :: { LHsKind RdrName }  -- promoted type, see Note [Promotion]
1136         : qtycon                          { L1 $ HsTyVar $ unLoc $1 }
1137         | '(' ')'                         { LL $ HsTyVar $ getRdrName unitTyCon }
1138         | '(' kind ',' comma_kinds1 ')'   { LL $ HsTupleTy HsBoxedTuple ($2 : $4) }
1139         | '[' kind ']'                    { LL $ HsListTy $2 }
1140
1141 comma_kinds1 :: { [LHsKind RdrName] }
1142         : kind                          { [$1] }
1143         | kind  ',' comma_kinds1        { $1 : $3 }
1144
1145 {- Note [Promotion]
1146    ~~~~~~~~~~~~~~~~
1147
1148 - Syntax of promoted qualified names
1149 We write 'Nat.Zero instead of Nat.'Zero when dealing with qualified
1150 names. Moreover ticks are only allowed in types, not in kinds, for a
1151 few reasons:
1152   1. we don't need quotes since we cannot define names in kinds
1153   2. if one day we merge types and kinds, tick would mean look in DataName
1154   3. we don't have a kind namespace anyway
1155
1156 - Syntax of explicit kind polymorphism  (IA0_TODO: not yet implemented)
1157 Kind abstraction is implicit. We write
1158 > data SList (s :: k -> *) (as :: [k]) where ...
1159 because it looks like what we do in terms
1160 > id (x :: a) = x
1161
1162 - Name resolution
1163 When the user write Zero instead of 'Zero in types, we parse it a
1164 HsTyVar ("Zero", TcClsName) instead of HsTyVar ("Zero", DataName). We
1165 deal with this in the renamer. If a HsTyVar ("Zero", TcClsName) is not
1166 bounded in the type level, then we look for it in the term level (we
1167 change its namespace to DataName, see Note [Demotion] in OccName). And
1168 both become a HsTyVar ("Zero", DataName) after the renamer.
1169
1170 -}
1171
1172
1173 -----------------------------------------------------------------------------
1174 -- Datatype declarations
1175
1176 gadt_constrlist :: { Located [LConDecl RdrName] }       -- Returned in order
1177         : 'where' '{'        gadt_constrs '}'      { L (comb2 $1 $3) (unLoc $3) }
1178         | 'where' vocurly    gadt_constrs close    { L (comb2 $1 $3) (unLoc $3) }
1179         | {- empty -}                              { noLoc [] }
1180
1181 gadt_constrs :: { Located [LConDecl RdrName] }
1182         : gadt_constr ';' gadt_constrs  { L (comb2 (head $1) $3) ($1 ++ unLoc $3) }
1183         | gadt_constr                   { L (getLoc (head $1)) $1 }
1184         | {- empty -}                   { noLoc [] }
1185
1186 -- We allow the following forms:
1187 --      C :: Eq a => a -> T a
1188 --      C :: forall a. Eq a => !a -> T a
1189 --      D { x,y :: a } :: T a
1190 --      forall a. Eq a => D { x,y :: a } :: T a
1191
1192 gadt_constr :: { [LConDecl RdrName] }   -- Returns a list because of:   C,D :: ty
1193         : con_list '::' sigtype
1194                 { map (sL (comb2 $1 $3)) (mkGadtDecl (unLoc $1) $3) } 
1195
1196                 -- Deprecated syntax for GADT record declarations
1197         | oqtycon '{' fielddecls '}' '::' sigtype
1198                 {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 $3 $6
1199                       ; cd' <- checkRecordSyntax cd
1200                       ; return [cd'] } }
1201
1202 constrs :: { Located [LConDecl RdrName] }
1203         : maybe_docnext '=' constrs1    { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) }
1204
1205 constrs1 :: { Located [LConDecl RdrName] }
1206         : constrs1 maybe_docnext '|' maybe_docprev constr { LL (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4) }
1207         | constr                                          { L1 [$1] }
1208
1209 constr :: { LConDecl RdrName }
1210         : maybe_docnext forall context '=>' constr_stuff maybe_docprev  
1211                 { let (con,details) = unLoc $5 in 
1212                   addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con (unLoc $2) $3 details))
1213                             ($1 `mplus` $6) }
1214         | maybe_docnext forall constr_stuff maybe_docprev
1215                 { let (con,details) = unLoc $3 in 
1216                   addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con (unLoc $2) (noLoc []) details))
1217                             ($1 `mplus` $4) }
1218
1219 forall :: { Located [LHsTyVarBndr RdrName] }
1220         : 'forall' tv_bndrs '.'         { LL $2 }
1221         | {- empty -}                   { noLoc [] }
1222
1223 constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
1224 -- We parse the constructor declaration 
1225 --      C t1 t2
1226 -- as a btype (treating C as a type constructor) and then convert C to be
1227 -- a data constructor.  Reason: it might continue like this:
1228 --      C t1 t2 %: D Int
1229 -- in which case C really would be a type constructor.  We can't resolve this
1230 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
1231         : btype                         {% splitCon $1 >>= return.LL }
1232         | btype conop btype             {  LL ($2, InfixCon $1 $3) }
1233
1234 fielddecls :: { [ConDeclField RdrName] }
1235         : {- empty -}     { [] }
1236         | fielddecls1     { $1 }
1237
1238 fielddecls1 :: { [ConDeclField RdrName] }
1239         : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
1240                       { [ addFieldDoc f $4 | f <- $1 ] ++ addFieldDocs $5 $2 }
1241                              -- This adds the doc $4 to each field separately
1242         | fielddecl   { $1 }
1243
1244 fielddecl :: { [ConDeclField RdrName] }    -- A list because of   f,g :: Int
1245         : maybe_docnext sig_vars '::' ctype maybe_docprev      { [ ConDeclField fld $4 ($1 `mplus` $5) 
1246                                                                  | fld <- reverse (unLoc $2) ] }
1247
1248 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
1249 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
1250 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
1251 -- We don't allow a context, but that's sorted out by the type checker.
1252 deriving :: { Located (Maybe [LHsType RdrName]) }
1253         : {- empty -}                           { noLoc Nothing }
1254         | 'deriving' qtycon                     { let { L loc tv = $2 }
1255                                                   in LL (Just [L loc (HsTyVar tv)]) } 
1256         | 'deriving' '(' ')'                    { LL (Just []) }
1257         | 'deriving' '(' inst_types1 ')'        { LL (Just $3) }
1258              -- Glasgow extension: allow partial 
1259              -- applications in derivings
1260
1261 -----------------------------------------------------------------------------
1262 -- Value definitions
1263
1264 {- Note [Declaration/signature overlap]
1265 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1266 There's an awkward overlap with a type signature.  Consider
1267         f :: Int -> Int = ...rhs...
1268    Then we can't tell whether it's a type signature or a value
1269    definition with a result signature until we see the '='.
1270    So we have to inline enough to postpone reductions until we know.
1271 -}
1272
1273 {-
1274   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
1275   instead of qvar, we get another shift/reduce-conflict. Consider the
1276   following programs:
1277   
1278      { (^^) :: Int->Int ; }          Type signature; only var allowed
1279
1280      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
1281                                      qvar allowed (because of instance decls)
1282   
1283   We can't tell whether to reduce var to qvar until after we've read the signatures.
1284 -}
1285
1286 docdecl :: { LHsDecl RdrName }
1287         : docdecld { L1 (DocD (unLoc $1)) }
1288
1289 docdecld :: { LDocDecl }
1290         : docnext                               { L1 (DocCommentNext (unLoc $1)) }
1291         | docprev                               { L1 (DocCommentPrev (unLoc $1)) }
1292         | docnamed                              { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
1293         | docsection                            { L1 (case (unLoc $1) of (n, doc) -> DocGroup n doc) }
1294
1295 decl    :: { Located (OrdList (LHsDecl RdrName)) }
1296         : sigdecl               { $1 }
1297
1298         | '!' aexp rhs          {% do { let { e = LL (SectionR (LL (HsVar bang_RDR)) $2) };
1299                                         pat <- checkPattern e;
1300                                         return $ LL $ unitOL $ LL $ ValD $
1301                                                PatBind pat (unLoc $3)
1302                                                        placeHolderType placeHolderNames (Nothing,[]) } }
1303                                 -- Turn it all into an expression so that
1304                                 -- checkPattern can check that bangs are enabled
1305
1306         | infixexp opt_sig rhs  {% do { r <- checkValDef $1 $2 $3;
1307                                         let { l = comb2 $1 $> };
1308                                         return $! (sL l (unitOL $! (sL l $ ValD r))) } }
1309         | docdecl               { LL $ unitOL $1 }
1310
1311 rhs     :: { Located (GRHSs RdrName) }
1312         : '=' exp wherebinds    { sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
1313         | gdrhs wherebinds      { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) }
1314
1315 gdrhs :: { Located [LGRHS RdrName] }
1316         : gdrhs gdrh            { LL ($2 : unLoc $1) }
1317         | gdrh                  { L1 [$1] }
1318
1319 gdrh :: { LGRHS RdrName }
1320         : '|' guardquals '=' exp        { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
1321
1322 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
1323         : 
1324         -- See Note [Declaration/signature overlap] for why we need infixexp here
1325           infixexp '::' sigtypedoc
1326                         {% do s <- checkValSig $1 $3 
1327                         ; return (LL $ unitOL (LL $ SigD s)) }
1328         | var ',' sig_vars '::' sigtypedoc
1329                                 { LL $ toOL [ LL $ SigD (TypeSig ($1 : unLoc $3) $5) ] }
1330         | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
1331                                              | n <- unLoc $3 ] }
1332         | '{-# INLINE' activation qvar '#-}'        
1333                 { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) }
1334         | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
1335                 { let inl_prag = mkInlinePragma (EmptyInlineSpec, FunLike) $2
1336                   in LL $ toOL [ LL $ SigD (SpecSig $3 t inl_prag) 
1337                                | t <- $5] }
1338         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
1339                 { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlinePragma (getSPEC_INLINE $1) $2))
1340                             | t <- $5] }
1341         | '{-# SPECIALISE' 'instance' inst_type '#-}'
1342                 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
1343
1344 -----------------------------------------------------------------------------
1345 -- Expressions
1346
1347 quasiquote :: { Located (HsQuasiQuote RdrName) }
1348         : TH_QUASIQUOTE   { let { loc = getLoc $1
1349                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
1350                                 ; quoterId = mkUnqual varName quoter }
1351                             in L1 (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
1352
1353 exp   :: { LHsExpr RdrName }
1354         : infixexp '::' sigtype         { LL $ ExprWithTySig $1 $3 }
1355         | infixexp '-<' exp             { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
1356         | infixexp '>-' exp             { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
1357         | infixexp '-<<' exp            { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
1358         | infixexp '>>-' exp            { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
1359         | infixexp                      { $1 }
1360
1361 infixexp :: { LHsExpr RdrName }
1362         : exp10                         { $1 }
1363         | infixexp qop exp10            { LL (OpApp $1 $2 (panic "fixity") $3) }
1364
1365 exp10 :: { LHsExpr RdrName }
1366         : '\\' apat apats opt_asig '->' exp     
1367                         { LL $ HsLam (mkMatchGroup [LL $ Match ($2:$3) $4
1368                                                                 (unguardedGRHSs $6)
1369                                                             ]) }
1370         | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
1371         | 'if' exp optSemi 'then' exp optSemi 'else' exp
1372                                         {% checkDoAndIfThenElse $2 $3 $5 $6 $8 >>
1373                                            return (LL $ mkHsIf $2 $5 $8) }
1374         | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
1375         | '-' fexp                              { LL $ NegApp $2 noSyntaxExpr }
1376
1377         | 'do' stmtlist                 { L (comb2 $1 $2) (mkHsDo DoExpr  (unLoc $2)) }
1378         | 'mdo' stmtlist                { L (comb2 $1 $2) (mkHsDo MDoExpr (unLoc $2)) }
1379
1380         | scc_annot exp                         { LL $ if opt_SccProfilingOn
1381                                                         then HsSCC (unLoc $1) $2
1382                                                         else HsPar $2 }
1383         | hpc_annot exp                         { LL $ if opt_Hpc
1384                                                         then HsTickPragma (unLoc $1) $2
1385                                                         else HsPar $2 }
1386
1387         | 'proc' aexp '->' exp  
1388                         {% checkPattern $2 >>= \ p -> 
1389                            return (LL $ HsProc p (LL $ HsCmdTop $4 [] 
1390                                                    placeHolderType undefined)) }
1391                                                 -- TODO: is LL right here?
1392
1393         | '{-# CORE' STRING '#-}' exp           { LL $ HsCoreAnn (getSTRING $2) $4 }
1394                                                     -- hdaume: core annotation
1395         | fexp                                  { $1 }
1396
1397 optSemi :: { Bool }
1398         : ';'         { True }
1399         | {- empty -} { False }
1400
1401 scc_annot :: { Located FastString }
1402         : '_scc_' STRING                        {% (addWarning Opt_WarnWarningsDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
1403                                    ( do scc <- getSCC $2; return $ LL scc ) }
1404         | '{-# SCC' STRING '#-}'                {% do scc <- getSCC $2; return $ LL scc }
1405         | '{-# SCC' VARID  '#-}'                { LL (getVARID $2) }
1406
1407 hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }
1408         : '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
1409                                                 { LL $ (getSTRING $2
1410                                                        ,( fromInteger $ getINTEGER $3
1411                                                         , fromInteger $ getINTEGER $5
1412                                                         )
1413                                                        ,( fromInteger $ getINTEGER $7
1414                                                         , fromInteger $ getINTEGER $9
1415                                                         )
1416                                                        )
1417                                                  }
1418
1419 fexp    :: { LHsExpr RdrName }
1420         : fexp aexp                             { LL $ HsApp $1 $2 }
1421         | aexp                                  { $1 }
1422
1423 aexp    :: { LHsExpr RdrName }
1424         : qvar '@' aexp                 { LL $ EAsPat $1 $3 }
1425         | '~' aexp                      { LL $ ELazyPat $2 }
1426         | aexp1                 { $1 }
1427
1428 aexp1   :: { LHsExpr RdrName }
1429         : aexp1 '{' fbinds '}'  {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) $3
1430                                       ; checkRecordSyntax (LL r) }}
1431         | aexp2                 { $1 }
1432
1433 aexp2   :: { LHsExpr RdrName }
1434         : ipvar                         { L1 (HsIPVar $! unLoc $1) }
1435         | qcname                        { L1 (HsVar   $! unLoc $1) }
1436         | literal                       { L1 (HsLit   $! unLoc $1) }
1437 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
1438 -- into HsOverLit when -foverloaded-strings is on.
1439 --      | STRING                        { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRING $1) placeHolderType) }
1440         | INTEGER                       { sL (getLoc $1) (HsOverLit $! mkHsIntegral (getINTEGER $1) placeHolderType) }
1441         | RATIONAL                      { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) placeHolderType) }
1442
1443         -- N.B.: sections get parsed by these next two productions.
1444         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
1445         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
1446         -- but the less cluttered version fell out of having texps.
1447         | '(' texp ')'                  { LL (HsPar $2) }
1448         | '(' tup_exprs ')'             { LL (ExplicitTuple $2 Boxed) }
1449
1450         | '(#' texp '#)'                { LL (ExplicitTuple [Present $2] Unboxed) }
1451         | '(#' tup_exprs '#)'           { LL (ExplicitTuple $2 Unboxed) }
1452
1453         | '[' list ']'                  { LL (unLoc $2) }
1454         | '[:' parr ':]'                { LL (unLoc $2) }
1455         | '_'                           { L1 EWildPat }
1456         
1457         -- Template Haskell Extension
1458         | TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice 
1459                                         (L1 $ HsVar (mkUnqual varName 
1460                                                         (getTH_ID_SPLICE $1)))) } 
1461         | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               
1462
1463
1464         | SIMPLEQUOTE  qvar     { LL $ HsBracket (VarBr True  (unLoc $2)) }
1465         | SIMPLEQUOTE  qcon     { LL $ HsBracket (VarBr True  (unLoc $2)) }
1466         | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr False (unLoc $2)) }
1467         | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr False (unLoc $2)) }
1468         | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }                       
1469         | '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }                       
1470         | '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
1471                                         return (LL $ HsBracket (PatBr p)) }
1472         | '[d|' cvtopbody '|]'  { LL $ HsBracket (DecBrL $2) }
1473         | quasiquote            { L1 (HsQuasiQuoteE (unLoc $1)) }
1474
1475         -- arrow notation extension
1476         | '(|' aexp2 cmdargs '|)'       { LL $ HsArrForm $2 Nothing (reverse $3) }
1477
1478 cmdargs :: { [LHsCmdTop RdrName] }
1479         : cmdargs acmd                  { $2 : $1 }
1480         | {- empty -}                   { [] }
1481
1482 acmd    :: { LHsCmdTop RdrName }
1483         : aexp2                 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1484
1485 cvtopbody :: { [LHsDecl RdrName] }
1486         :  '{'            cvtopdecls0 '}'               { $2 }
1487         |      vocurly    cvtopdecls0 close             { $2 }
1488
1489 cvtopdecls0 :: { [LHsDecl RdrName] }
1490         : {- empty -}           { [] }
1491         | cvtopdecls            { $1 }
1492
1493 -----------------------------------------------------------------------------
1494 -- Tuple expressions
1495
1496 -- "texp" is short for tuple expressions: 
1497 -- things that can appear unparenthesized as long as they're
1498 -- inside parens or delimitted by commas
1499 texp :: { LHsExpr RdrName }
1500         : exp                           { $1 }
1501
1502         -- Note [Parsing sections]
1503         -- ~~~~~~~~~~~~~~~~~~~~~~~
1504         -- We include left and right sections here, which isn't
1505         -- technically right according to the Haskell standard.
1506         -- For example (3 +, True) isn't legal.
1507         -- However, we want to parse bang patterns like
1508         --      (!x, !y)
1509         -- and it's convenient to do so here as a section
1510         -- Then when converting expr to pattern we unravel it again
1511         -- Meanwhile, the renamer checks that real sections appear
1512         -- inside parens.
1513         | infixexp qop        { LL $ SectionL $1 $2 }
1514         | qopm infixexp       { LL $ SectionR $1 $2 }
1515
1516        -- View patterns get parenthesized above
1517         | exp '->' texp   { LL $ EViewPat $1 $3 }
1518
1519 -- Always at least one comma
1520 tup_exprs :: { [HsTupArg RdrName] }
1521            : texp commas_tup_tail  { Present $1 : $2 }
1522            | commas tup_tail       { replicate $1 missingTupArg ++ $2 }
1523
1524 -- Always starts with commas; always follows an expr
1525 commas_tup_tail :: { [HsTupArg RdrName] }
1526 commas_tup_tail : commas tup_tail  { replicate ($1-1) missingTupArg ++ $2 }
1527
1528 -- Always follows a comma
1529 tup_tail :: { [HsTupArg RdrName] }
1530           : texp commas_tup_tail        { Present $1 : $2 }
1531           | texp                        { [Present $1] }
1532           | {- empty -}                 { [missingTupArg] }
1533
1534 -----------------------------------------------------------------------------
1535 -- List expressions
1536
1537 -- The rules below are little bit contorted to keep lexps left-recursive while
1538 -- avoiding another shift/reduce-conflict.
1539
1540 list :: { LHsExpr RdrName }
1541         : texp                  { L1 $ ExplicitList placeHolderType [$1] }
1542         | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1543         | texp '..'             { LL $ ArithSeq noPostTcExpr (From $1) }
1544         | texp ',' exp '..'     { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
1545         | texp '..' exp         { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
1546         | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1547         | texp '|' flattenedpquals      
1548              {% checkMonadComp >>= \ ctxt ->
1549                 return (sL (comb2 $1 $>) $ 
1550                         mkHsComp ctxt (unLoc $3) $1) }
1551
1552 lexps :: { Located [LHsExpr RdrName] }
1553         : lexps ',' texp                { LL (((:) $! $3) $! unLoc $1) }
1554         | texp ',' texp                 { LL [$3,$1] }
1555
1556 -----------------------------------------------------------------------------
1557 -- List Comprehensions
1558
1559 flattenedpquals :: { Located [LStmt RdrName] }
1560     : pquals   { case (unLoc $1) of
1561                     [qs] -> L1 qs
1562                     -- We just had one thing in our "parallel" list so 
1563                     -- we simply return that thing directly
1564                     
1565                     qss -> L1 [L1 $ ParStmt [(qs, undefined) | qs <- qss] noSyntaxExpr noSyntaxExpr noSyntaxExpr]
1566                     -- We actually found some actual parallel lists so
1567                     -- we wrap them into as a ParStmt
1568                 }
1569
1570 pquals :: { Located [[LStmt RdrName]] }
1571     : squals '|' pquals     { L (getLoc $2) (reverse (unLoc $1) : unLoc $3) }
1572     | squals                { L (getLoc $1) [reverse (unLoc $1)] }
1573
1574 squals :: { Located [LStmt RdrName] }   -- In reverse order, because the last 
1575                                         -- one can "grab" the earlier ones
1576     : squals ',' transformqual               { LL [L (getLoc $3) ((unLoc $3) (reverse (unLoc $1)))] }
1577     | squals ',' qual                        { LL ($3 : unLoc $1) }
1578     | transformqual                          { LL [L (getLoc $1) ((unLoc $1) [])] }
1579     | qual                                   { L1 [$1] }
1580 --  | transformquals1 ',' '{|' pquals '|}'   { LL ($4 : unLoc $1) }
1581 --  | '{|' pquals '|}'                       { L1 [$2] }
1582
1583
1584 -- It is possible to enable bracketing (associating) qualifier lists
1585 -- by uncommenting the lines with {| |} above. Due to a lack of
1586 -- consensus on the syntax, this feature is not being used until we
1587 -- get user demand.
1588
1589 transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) }
1590                         -- Function is applied to a list of stmts *in order*
1591     : 'then' exp                           { LL $ \ss -> (mkTransformStmt    ss $2)    }
1592     | 'then' exp 'by' exp                  { LL $ \ss -> (mkTransformByStmt  ss $2 $4) }
1593     | 'then' 'group' 'using' exp           { LL $ \ss -> (mkGroupUsingStmt   ss $4)    }
1594     | 'then' 'group' 'by' exp 'using' exp  { LL $ \ss -> (mkGroupByUsingStmt ss $4 $6) }
1595
1596 -- Note that 'group' is a special_id, which means that you can enable
1597 -- TransformListComp while still using Data.List.group. However, this
1598 -- introduces a shift/reduce conflict. Happy chooses to resolve the conflict
1599 -- in by choosing the "group by" variant, which is what we want.
1600
1601 -----------------------------------------------------------------------------
1602 -- Parallel array expressions
1603
1604 -- The rules below are little bit contorted; see the list case for details.
1605 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1606 -- Moreover, we allow explicit arrays with no element (represented by the nil
1607 -- constructor in the list case).
1608
1609 parr :: { LHsExpr RdrName }
1610         :                               { noLoc (ExplicitPArr placeHolderType []) }
1611         | texp                          { L1 $ ExplicitPArr placeHolderType [$1] }
1612         | lexps                         { L1 $ ExplicitPArr placeHolderType 
1613                                                        (reverse (unLoc $1)) }
1614         | texp '..' exp                 { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
1615         | texp ',' exp '..' exp         { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1616         | texp '|' flattenedpquals      { LL $ mkHsComp PArrComp (unLoc $3) $1 }
1617
1618 -- We are reusing `lexps' and `flattenedpquals' from the list case.
1619
1620 -----------------------------------------------------------------------------
1621 -- Guards
1622
1623 guardquals :: { Located [LStmt RdrName] }
1624     : guardquals1           { L (getLoc $1) (reverse (unLoc $1)) }
1625
1626 guardquals1 :: { Located [LStmt RdrName] }
1627     : guardquals1 ',' qual  { LL ($3 : unLoc $1) }
1628     | qual                  { L1 [$1] }
1629
1630 -----------------------------------------------------------------------------
1631 -- Case alternatives
1632
1633 altslist :: { Located [LMatch RdrName] }
1634         : '{'            alts '}'       { LL (reverse (unLoc $2)) }
1635         |     vocurly    alts  close    { L (getLoc $2) (reverse (unLoc $2)) }
1636
1637 alts    :: { Located [LMatch RdrName] }
1638         : alts1                         { L1 (unLoc $1) }
1639         | ';' alts                      { LL (unLoc $2) }
1640
1641 alts1   :: { Located [LMatch RdrName] }
1642         : alts1 ';' alt                 { LL ($3 : unLoc $1) }
1643         | alts1 ';'                     { LL (unLoc $1) }
1644         | alt                           { L1 [$1] }
1645
1646 alt     :: { LMatch RdrName }
1647         : pat opt_sig alt_rhs           { LL (Match [$1] $2 (unLoc $3)) }
1648
1649 alt_rhs :: { Located (GRHSs RdrName) }
1650         : ralt wherebinds               { LL (GRHSs (unLoc $1) (unLoc $2)) }
1651
1652 ralt :: { Located [LGRHS RdrName] }
1653         : '->' exp                      { LL (unguardedRHS $2) }
1654         | gdpats                        { L1 (reverse (unLoc $1)) }
1655
1656 gdpats :: { Located [LGRHS RdrName] }
1657         : gdpats gdpat                  { LL ($2 : unLoc $1) }
1658         | gdpat                         { L1 [$1] }
1659
1660 gdpat   :: { LGRHS RdrName }
1661         : '|' guardquals '->' exp               { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
1662
1663 -- 'pat' recognises a pattern, including one with a bang at the top
1664 --      e.g.  "!x" or "!(x,y)" or "C a b" etc
1665 -- Bangs inside are parsed as infix operator applications, so that
1666 -- we parse them right when bang-patterns are off
1667 pat     :: { LPat RdrName }
1668 pat     :  exp                  {% checkPattern $1 }
1669         | '!' aexp              {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1670
1671 apat   :: { LPat RdrName }      
1672 apat    : aexp                  {% checkPattern $1 }
1673         | '!' aexp              {% checkPattern (LL (SectionR (L1 (HsVar bang_RDR)) $2)) }
1674
1675 apats  :: { [LPat RdrName] }
1676         : apat apats            { $1 : $2 }
1677         | {- empty -}           { [] }
1678
1679 -----------------------------------------------------------------------------
1680 -- Statement sequences
1681
1682 stmtlist :: { Located [LStmt RdrName] }
1683         : '{'           stmts '}'       { LL (unLoc $2) }
1684         |     vocurly   stmts close     { $2 }
1685
1686 --      do { ;; s ; s ; ; s ;; }
1687 -- The last Stmt should be an expression, but that's hard to enforce
1688 -- here, because we need too much lookahead if we see do { e ; }
1689 -- So we use ExprStmts throughout, and switch the last one over
1690 -- in ParseUtils.checkDo instead
1691 stmts :: { Located [LStmt RdrName] }
1692         : stmt stmts_help               { LL ($1 : unLoc $2) }
1693         | ';' stmts                     { LL (unLoc $2) }
1694         | {- empty -}                   { noLoc [] }
1695
1696 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1697         : ';' stmts                     { LL (unLoc $2) }
1698         | {- empty -}                   { noLoc [] }
1699
1700 -- For typing stmts at the GHCi prompt, where 
1701 -- the input may consist of just comments.
1702 maybe_stmt :: { Maybe (LStmt RdrName) }
1703         : stmt                          { Just $1 }
1704         | {- nothing -}                 { Nothing }
1705
1706 stmt  :: { LStmt RdrName }
1707         : qual                              { $1 }
1708         | 'rec' stmtlist                { LL $ mkRecStmt (unLoc $2) }
1709
1710 qual  :: { LStmt RdrName }
1711     : pat '<-' exp                      { LL $ mkBindStmt $1 $3 }
1712     | exp                                   { L1 $ mkExprStmt $1 }
1713     | 'let' binds                       { LL $ LetStmt (unLoc $2) }
1714
1715 -----------------------------------------------------------------------------
1716 -- Record Field Update/Construction
1717
1718 fbinds  :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
1719         : fbinds1                       { $1 }
1720         | {- empty -}                   { ([], False) }
1721
1722 fbinds1 :: { ([HsRecField RdrName (LHsExpr RdrName)], Bool) }
1723         : fbind ',' fbinds1             { case $3 of (flds, dd) -> ($1 : flds, dd) } 
1724         | fbind                         { ([$1], False) }
1725         | '..'                          { ([],   True) }
1726   
1727 fbind   :: { HsRecField RdrName (LHsExpr RdrName) }
1728         : qvar '=' exp  { HsRecField $1 $3                False }
1729         | qvar          { HsRecField $1 placeHolderPunRhs True }
1730                         -- In the punning case, use a place-holder
1731                         -- The renamer fills in the final value
1732
1733 -----------------------------------------------------------------------------
1734 -- Implicit Parameter Bindings
1735
1736 dbinds  :: { Located [LIPBind RdrName] }
1737         : dbinds ';' dbind              { let { this = $3; rest = unLoc $1 }
1738                               in rest `seq` this `seq` LL (this : rest) }
1739         | dbinds ';'                    { LL (unLoc $1) }
1740         | dbind                         { let this = $1 in this `seq` L1 [this] }
1741 --      | {- empty -}                   { [] }
1742
1743 dbind   :: { LIPBind RdrName }
1744 dbind   : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
1745
1746 ipvar   :: { Located (IPName RdrName) }
1747         : IPDUPVARID            { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
1748
1749 -----------------------------------------------------------------------------
1750 -- Warnings and deprecations
1751
1752 namelist :: { Located [RdrName] }
1753 namelist : name_var              { L1 [unLoc $1] }
1754          | name_var ',' namelist { LL (unLoc $1 : unLoc $3) }
1755
1756 name_var :: { Located RdrName }
1757 name_var : var { $1 }
1758          | con { $1 }
1759
1760 -----------------------------------------
1761 -- Data constructors
1762 qcon    :: { Located RdrName }
1763         : qconid                { $1 }
1764         | '(' qconsym ')'       { LL (unLoc $2) }
1765         | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1766 -- The case of '[:' ':]' is part of the production `parr'
1767
1768 con     :: { Located RdrName }
1769         : conid                 { $1 }
1770         | '(' consym ')'        { LL (unLoc $2) }
1771         | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1772
1773 con_list :: { Located [Located RdrName] }
1774 con_list : con                  { L1 [$1] }
1775          | con ',' con_list     { LL ($1 : unLoc $3) }
1776
1777 sysdcon :: { Located DataCon }  -- Wired in data constructors
1778         : '(' ')'               { LL unitDataCon }
1779         | '(' commas ')'        { LL $ tupleCon BoxedTuple ($2 + 1) }
1780         | '(#' '#)'             { LL $ unboxedUnitDataCon }
1781         | '(#' commas '#)'      { LL $ tupleCon UnboxedTuple ($2 + 1) }
1782         | '[' ']'               { LL nilDataCon }
1783
1784 conop :: { Located RdrName }
1785         : consym                { $1 }  
1786         | '`' conid '`'         { LL (unLoc $2) }
1787
1788 qconop :: { Located RdrName }
1789         : qconsym               { $1 }
1790         | '`' qconid '`'        { LL (unLoc $2) }
1791
1792 ----------------------------------------------------------------------------
1793 -- Type constructors
1794
1795
1796 -- See Note [Unit tuples] in HsTypes for the distinction 
1797 -- between gtycon and ntgtycon
1798 gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tuples
1799         : ntgtycon                      { $1 }
1800         | '(' ')'                       { LL $ getRdrName unitTyCon }
1801         | '(#' '#)'                     { LL $ getRdrName unboxedUnitTyCon }
1802
1803 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
1804         : oqtycon                       { $1 }
1805         | '(' commas ')'                { LL $ getRdrName (tupleTyCon BoxedTuple ($2 + 1)) }
1806         | '(#' commas '#)'              { LL $ getRdrName (tupleTyCon UnboxedTuple ($2 + 1)) }
1807         | '(' '->' ')'                  { LL $ getRdrName funTyCon }
1808         | '[' ']'                       { LL $ listTyCon_RDR }
1809         | '[:' ':]'                     { LL $ parrTyCon_RDR }
1810         | '(' '~#' ')'                  { LL $ getRdrName eqPrimTyCon }
1811
1812 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
1813                                 -- These can appear in export lists
1814         : qtycon                        { $1 }
1815         | '(' qtyconsym ')'             { LL (unLoc $2) }
1816         | '(' '~' ')'                   { LL $ eqTyCon_RDR }
1817
1818 qtyconop :: { Located RdrName } -- Qualified or unqualified
1819         : qtyconsym                     { $1 }
1820         | '`' qtycon '`'                { LL (unLoc $2) }
1821
1822 qtycon :: { Located RdrName }   -- Qualified or unqualified
1823         : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
1824         | PREFIXQCONSYM                 { L1 $! mkQual tcClsName (getPREFIXQCONSYM $1) }
1825         | tycon                         { $1 }
1826
1827 tycon   :: { Located RdrName }  -- Unqualified
1828         : CONID                         { L1 $! mkUnqual tcClsName (getCONID $1) }
1829
1830 qtyconsym :: { Located RdrName }
1831         : QCONSYM                       { L1 $! mkQual tcClsName (getQCONSYM $1) }
1832         | tyconsym                      { $1 }
1833
1834 tyconsym :: { Located RdrName }
1835         : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1836
1837 -----------------------------------------------------------------------------
1838 -- Operators
1839
1840 op      :: { Located RdrName }   -- used in infix decls
1841         : varop                 { $1 }
1842         | conop                 { $1 }
1843
1844 varop   :: { Located RdrName }
1845         : varsym                { $1 }
1846         | '`' varid '`'         { LL (unLoc $2) }
1847
1848 qop     :: { LHsExpr RdrName }   -- used in sections
1849         : qvarop                { L1 $ HsVar (unLoc $1) }
1850         | qconop                { L1 $ HsVar (unLoc $1) }
1851
1852 qopm    :: { LHsExpr RdrName }   -- used in sections
1853         : qvaropm               { L1 $ HsVar (unLoc $1) }
1854         | qconop                { L1 $ HsVar (unLoc $1) }
1855
1856 qvarop :: { Located RdrName }
1857         : qvarsym               { $1 }
1858         | '`' qvarid '`'        { LL (unLoc $2) }
1859
1860 qvaropm :: { Located RdrName }
1861         : qvarsym_no_minus      { $1 }
1862         | '`' qvarid '`'        { LL (unLoc $2) }
1863
1864 -----------------------------------------------------------------------------
1865 -- Type variables
1866
1867 tyvar   :: { Located RdrName }
1868 tyvar   : tyvarid               { $1 }
1869         | '(' tyvarsym ')'      { LL (unLoc $2) }
1870
1871 tyvarop :: { Located RdrName }
1872 tyvarop : '`' tyvarid '`'       { LL (unLoc $2) }
1873         | tyvarsym              { $1 }
1874         | '.'                   {% parseErrorSDoc (getLoc $1) 
1875                                       (vcat [ptext (sLit "Illegal symbol '.' in type"), 
1876                                              ptext (sLit "Perhaps you intended -XRankNTypes or similar flag"),
1877                                              ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")])
1878                                 }
1879
1880 tyvarid :: { Located RdrName }
1881         : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
1882         | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
1883         | 'unsafe'              { L1 $! mkUnqual tvName (fsLit "unsafe") }
1884         | 'safe'                { L1 $! mkUnqual tvName (fsLit "safe") }
1885         | 'interruptible'       { L1 $! mkUnqual tvName (fsLit "interruptible") }
1886
1887 tyvarsym :: { Located RdrName }
1888 -- Does not include "!", because that is used for strictness marks
1889 --               or ".", because that separates the quantified type vars from the rest
1890 --               or "*", because that's used for kinds
1891 tyvarsym : VARSYM               { L1 $! mkUnqual tvName (getVARSYM $1) }
1892
1893 -----------------------------------------------------------------------------
1894 -- Variables 
1895
1896 var     :: { Located RdrName }
1897         : varid                 { $1 }
1898         | '(' varsym ')'        { LL (unLoc $2) }
1899
1900 qvar    :: { Located RdrName }
1901         : qvarid                { $1 }
1902         | '(' varsym ')'        { LL (unLoc $2) }
1903         | '(' qvarsym1 ')'      { LL (unLoc $2) }
1904 -- We've inlined qvarsym here so that the decision about
1905 -- whether it's a qvar or a var can be postponed until
1906 -- *after* we see the close paren.
1907
1908 qvarid :: { Located RdrName }
1909         : varid                 { $1 }
1910         | QVARID                { L1 $! mkQual varName (getQVARID $1) }
1911         | PREFIXQVARSYM         { L1 $! mkQual varName (getPREFIXQVARSYM $1) }
1912
1913 varid :: { Located RdrName }
1914         : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
1915         | special_id            { L1 $! mkUnqual varName (unLoc $1) }
1916         | 'unsafe'              { L1 $! mkUnqual varName (fsLit "unsafe") }
1917         | 'safe'                { L1 $! mkUnqual varName (fsLit "safe") }
1918         | 'interruptible'       { L1 $! mkUnqual varName (fsLit "interruptible") }
1919         | 'forall'              { L1 $! mkUnqual varName (fsLit "forall") }
1920         | 'family'              { L1 $! mkUnqual varName (fsLit "family") }
1921
1922 qvarsym :: { Located RdrName }
1923         : varsym                { $1 }
1924         | qvarsym1              { $1 }
1925
1926 qvarsym_no_minus :: { Located RdrName }
1927         : varsym_no_minus       { $1 }
1928         | qvarsym1              { $1 }
1929
1930 qvarsym1 :: { Located RdrName }
1931 qvarsym1 : QVARSYM              { L1 $ mkQual varName (getQVARSYM $1) }
1932
1933 varsym :: { Located RdrName }
1934         : varsym_no_minus       { $1 }
1935         | '-'                   { L1 $ mkUnqual varName (fsLit "-") }
1936
1937 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1938         : VARSYM                { L1 $ mkUnqual varName (getVARSYM $1) }
1939         | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
1940
1941
1942 -- These special_ids are treated as keywords in various places, 
1943 -- but as ordinary ids elsewhere.   'special_id' collects all these
1944 -- except 'unsafe', 'interruptible', 'forall', and 'family' whose treatment differs
1945 -- depending on context 
1946 special_id :: { Located FastString }
1947 special_id
1948         : 'as'                  { L1 (fsLit "as") }
1949         | 'qualified'           { L1 (fsLit "qualified") }
1950         | 'hiding'              { L1 (fsLit "hiding") }
1951         | 'export'              { L1 (fsLit "export") }
1952         | 'label'               { L1 (fsLit "label")  }
1953         | 'dynamic'             { L1 (fsLit "dynamic") }
1954         | 'stdcall'             { L1 (fsLit "stdcall") }
1955         | 'ccall'               { L1 (fsLit "ccall") }
1956         | 'capi'                { L1 (fsLit "capi") }
1957         | 'prim'                { L1 (fsLit "prim") }
1958         | 'group'               { L1 (fsLit "group") }
1959
1960 special_sym :: { Located FastString }
1961 special_sym : '!'       { L1 (fsLit "!") }
1962             | '.'       { L1 (fsLit ".") }
1963             | '*'       { L1 (fsLit "*") }
1964
1965 -----------------------------------------------------------------------------
1966 -- Data constructors
1967
1968 qconid :: { Located RdrName }   -- Qualified or unqualified
1969         : conid                 { $1 }
1970         | QCONID                { L1 $! mkQual dataName (getQCONID $1) }
1971         | PREFIXQCONSYM         { L1 $! mkQual dataName (getPREFIXQCONSYM $1) }
1972
1973 conid   :: { Located RdrName }
1974         : CONID                 { L1 $ mkUnqual dataName (getCONID $1) }
1975
1976 qconsym :: { Located RdrName }  -- Qualified or unqualified
1977         : consym                { $1 }
1978         | QCONSYM               { L1 $ mkQual dataName (getQCONSYM $1) }
1979
1980 consym :: { Located RdrName }
1981         : CONSYM                { L1 $ mkUnqual dataName (getCONSYM $1) }
1982
1983         -- ':' means only list cons
1984         | ':'                   { L1 $ consDataCon_RDR }
1985
1986
1987 -----------------------------------------------------------------------------
1988 -- Literals
1989
1990 literal :: { Located HsLit }
1991         : CHAR                  { L1 $ HsChar       $ getCHAR $1 }
1992         | STRING                { L1 $ HsString     $ getSTRING $1 }
1993         | PRIMINTEGER           { L1 $ HsIntPrim    $ getPRIMINTEGER $1 }
1994         | PRIMWORD              { L1 $ HsWordPrim    $ getPRIMWORD $1 }
1995         | PRIMCHAR              { L1 $ HsCharPrim   $ getPRIMCHAR $1 }
1996         | PRIMSTRING            { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1997         | PRIMFLOAT             { L1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
1998         | PRIMDOUBLE            { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1999
2000 -----------------------------------------------------------------------------
2001 -- Layout
2002
2003 close :: { () }
2004         : vccurly               { () } -- context popped in lexer.
2005         | error                 {% popContext }
2006
2007 -----------------------------------------------------------------------------
2008 -- Miscellaneous (mostly renamings)
2009
2010 modid   :: { Located ModuleName }
2011         : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
2012         | QCONID                { L1 $ let (mod,c) = getQCONID $1 in
2013                                   mkModuleNameFS
2014                                    (mkFastString
2015                                      (unpackFS mod ++ '.':unpackFS c))
2016                                 }
2017
2018 commas :: { Int }
2019         : commas ','                    { $1 + 1 }
2020         | ','                           { 1 }
2021
2022 -----------------------------------------------------------------------------
2023 -- Documentation comments
2024
2025 docnext :: { LHsDocString }
2026   : DOCNEXT {% return (L1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
2027
2028 docprev :: { LHsDocString }
2029   : DOCPREV {% return (L1 (HsDocString (mkFastString (getDOCPREV $1)))) }
2030
2031 docnamed :: { Located (String, HsDocString) }
2032   : DOCNAMED {%
2033       let string = getDOCNAMED $1 
2034           (name, rest) = break isSpace string
2035       in return (L1 (name, HsDocString (mkFastString rest))) }
2036
2037 docsection :: { Located (Int, HsDocString) }
2038   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
2039         return (L1 (n, HsDocString (mkFastString doc))) }
2040
2041 moduleheader :: { Maybe LHsDocString }
2042         : DOCNEXT {% let string = getDOCNEXT $1 in
2043                      return (Just (L1 (HsDocString (mkFastString string)))) }
2044
2045 maybe_docprev :: { Maybe LHsDocString }
2046         : docprev                       { Just $1 }
2047         | {- empty -}                   { Nothing }
2048
2049 maybe_docnext :: { Maybe LHsDocString }
2050         : docnext                       { Just $1 }
2051         | {- empty -}                   { Nothing }
2052
2053 {
2054 happyError :: P a
2055 happyError = srcParseFail
2056
2057 getVARID        (L _ (ITvarid    x)) = x
2058 getCONID        (L _ (ITconid    x)) = x
2059 getVARSYM       (L _ (ITvarsym   x)) = x
2060 getCONSYM       (L _ (ITconsym   x)) = x
2061 getQVARID       (L _ (ITqvarid   x)) = x
2062 getQCONID       (L _ (ITqconid   x)) = x
2063 getQVARSYM      (L _ (ITqvarsym  x)) = x
2064 getQCONSYM      (L _ (ITqconsym  x)) = x
2065 getPREFIXQVARSYM (L _ (ITprefixqvarsym  x)) = x
2066 getPREFIXQCONSYM (L _ (ITprefixqconsym  x)) = x
2067 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
2068 getCHAR         (L _ (ITchar     x)) = x
2069 getSTRING       (L _ (ITstring   x)) = x
2070 getINTEGER      (L _ (ITinteger  x)) = x
2071 getRATIONAL     (L _ (ITrational x)) = x
2072 getPRIMCHAR     (L _ (ITprimchar   x)) = x
2073 getPRIMSTRING   (L _ (ITprimstring x)) = x
2074 getPRIMINTEGER  (L _ (ITprimint    x)) = x
2075 getPRIMWORD     (L _ (ITprimword x)) = x
2076 getPRIMFLOAT    (L _ (ITprimfloat  x)) = x
2077 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
2078 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
2079 getINLINE       (L _ (ITinline_prag inl conl)) = (inl,conl)
2080 getSPEC_INLINE  (L _ (ITspec_inline_prag True))  = (Inline,  FunLike)
2081 getSPEC_INLINE  (L _ (ITspec_inline_prag False)) = (NoInline,FunLike)
2082
2083 getDOCNEXT (L _ (ITdocCommentNext x)) = x
2084 getDOCPREV (L _ (ITdocCommentPrev x)) = x
2085 getDOCNAMED (L _ (ITdocCommentNamed x)) = x
2086 getDOCSECTION (L _ (ITdocSection n x)) = (n, x)
2087
2088 getSCC :: Located Token -> P FastString
2089 getSCC lt = do let s = getSTRING lt
2090                    err = "Spaces are not allowed in SCCs"
2091                -- We probably actually want to be more restrictive than this
2092                if ' ' `elem` unpackFS s
2093                    then failSpanMsgP (getLoc lt) (text err)
2094                    else return s
2095
2096 -- Utilities for combining source spans
2097 comb2 :: Located a -> Located b -> SrcSpan
2098 comb2 a b = a `seq` b `seq` combineLocs a b
2099
2100 comb3 :: Located a -> Located b -> Located c -> SrcSpan
2101 comb3 a b c = a `seq` b `seq` c `seq`
2102     combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
2103
2104 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
2105 comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
2106     (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
2107                 combineSrcSpans (getLoc c) (getLoc d))
2108
2109 -- strict constructor version:
2110 {-# INLINE sL #-}
2111 sL :: SrcSpan -> a -> Located a
2112 sL span a = span `seq` a `seq` L span a
2113
2114 -- Make a source location for the file.  We're a bit lazy here and just
2115 -- make a point SrcSpan at line 1, column 0.  Strictly speaking we should
2116 -- try to find the span of the whole file (ToDo).
2117 fileSrcSpan :: P SrcSpan
2118 fileSrcSpan = do 
2119   l <- getSrcLoc; 
2120   let loc = mkSrcLoc (srcLocFile l) 1 1;
2121   return (mkSrcSpan loc loc)
2122 }