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