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