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