Context Navigation

Parser.y.pp

Visit:

Revision fc8959acae02605c71b775c8d403e38b5cc6fecd, 94.1 KB (checked in by Simon Peyton Jones <simonpj@…>, 2 weeks ago)

Refactor LHsTyVarBndrs to fix Trac #6081

This is really a small change, but it touches a lot of files quite
significantly. The real goal is to put the implicitly-bound kind
variables of a data/class decl in the right place, namely on the
LHsTyVarBndrs type, which now looks like

data LHsTyVarBndrs name

= HsQTvs { hsq_kvs :: [Name]

, hsq_tvs: [LHsTyVarBndr name] }

This little change made the type checker neater in a number of
ways, but it was fiddly to push through the changes.

Property mode set to 100644

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

Note: See TracBrowser for help on using the browser.

Download in other formats:

Original Format