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