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