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