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