Context Navigation

FortranParser03.g

main

Last change on this file was aad342c, checked in by Stephen Siegel <siegel@…>, 3 years ago

Performing huge refactor to incorporate ABC, GMC, and SARL into CIVL repo and use Java modules.

git-svn-id: svn://vsl.cis.udel.edu/civl/trunk@5664 fb995dde-84ed-4084-dfe6-e5aef3e2452c

Property mode set to 100644

File size: 150.2 KB

Line
1	/*
2	* NOTES
3	*
4	* R303, R406, R417, R427, R428 underscore - added _ to rule (what happened
5	* to it?) * R410 sign - had '?' rather than '-'
6	* R1209 import-stmt: MISSING a ]
7	*
8	* check comments regarding deleted for correctness
9	*
10	* Replace all occurrences of T_EOS with end_of_stmt rule call so there is
11	* a way to look ahead at the next token to see if it belongs to the same
12	* input stream as the current one. This serves as a way to detect that an
13	* include statement had occurred during the lexical phase.
14	*
15	* TODO add (label)? to all statements...
16	* finished: continue-stmt, end-do-stmt
17	*
18	*/
19
20
21	// added (label)? to any rule for a statement (*_stmt, for the most
22	// part) because the draft says a label can exist with any statement.
23	// questions are:
24	// - what about constructs such as if/else; where can labels all occur?
25	// - or the masked_elsewhere_stmt rule...
26
27
28	parser grammar FortranParser03;
29
30	options {
31	language=Java;
32	superClass=AbstractFortranParser;
33	//////////////
34	// NOTE: tokenVocab causes an antlr warning if used in conjuction
35	// with F2008. The warning should be ignored as an inconsistent tokens
36	// file will be generated otherwise.
37	tokenVocab=FortranLexer;
38	}
39
40	//////////////
41	// This header must be declared for F2003 grammar; otherwise
42	// it should be commented out (if F2008 grammar is used
43	// with F2003 as the base). Note that this means that
44	// the java package statement,
45	//
46	// package fortran.ofp.parser.java
47	//
48	// must be copied into the generated java file, FortranParser03.java,
49	// by hand. If the header is defined (see below), antlr v3.2 will
50	// emit an error. However, the error can be safely ignored and
51	// rerunning make will build the OFP jar file correctly.
52	//
53	@header {
54	package dev.civl.abc.front.fortran.parse;
55	import dev.civl.abc.token.IF.CivlcToken;
56	}
57	//
58	//@F2003@@header {
59	//@F2003@ package dev.civl.abc.front.fortran.parse;
60	//@F2003@ import package dev.civl.abc.front.fortran.parse.IActionEnums;
61	//@F2003@}
62
63	@members {
64
65	public void initialize(String[] args, String kind, String filename) {
66	action = FortranParserActionFactory.newAction(args, this, kind, filename);
67	initialize(this, action, filename);
68	action.start_of_file(this.filename);
69	}
70
71	//
72	// submodule is not part of F2003 but is in IFortranParser interface
73	//
74	public final void submodule() throws RecognitionException {
75	System.err.println("SUBMODULE is not part of Fortran 2003");
76	delegate.has_error_occurred = true;
77	}
78
79	}
80
81
82	/*
83	* Section 1:
84	*/
85
86	/*
87	* Section 2:
88	*/
89
90
91	/**
92	* Got rid of the following rules:
93	* program
94	* program_unit
95	* external_subprogram
96	*
97	* this was done because Main() should now handle the top level rules
98	* to try and reduce the amount of backtracking that must be done!
99	* --Rickett, 12.07.06
100	*
101	* for some reason, leaving these three rules in, even though main()
102	* does NOT call them, prevents the parser from failing on the tests:
103	* main_program.f03
104	* note_6.24.f03
105	* it appears to be something with the (program_unit)* part of the
106	* program rule. --12.07.06
107	* --resolved: there's a difference in the code that is generated for
108	* the end_of_stmt rule if these three rules are in there.
109	* to get around this, i modified the end_of_stmt rule.
110	* see it for more details. --12.11.06
111	*
112	*/
113
114	// // R201
115	// program
116	// : program_unit
117	// ( program_unit )*
118	// ;
119
120	// // R202
121	// // backtracking needed to resolve prefix (e.g., REAL) ambiguity with main_program (REAL)
122	// program_unit
123	// options {backtrack=true; memoize=true; greedy=true;}
124	// : main_program
125	// \| external_subprogram
126	// \| module
127	// \| block_data
128	// ;
129
130	// // R203
131	// // modified to factor optional prefix
132	// external_subprogram
133	// : (prefix)? function_subprogram
134	// \| subroutine_subprogram
135	// ;
136
137	// R1101
138	// specification_part made non-optional to remove END ambiguity (as can be empty)
139	main_program
140	@init {
141	boolean hasProgramStmt = false;
142	boolean hasExecutionPart = false;
143	boolean hasInternalSubprogramPart = false;
144	}
145	: { action.main_program__begin(); }
146	( program_stmt {hasProgramStmt = true;})?
147	specification_part
148	( execution_part {hasExecutionPart = true;})?
149	( internal_subprogram_part {hasInternalSubprogramPart = true;})?
150	end_program_stmt
151	{ action.main_program(hasProgramStmt, hasExecutionPart,
152	hasInternalSubprogramPart); }
153	;
154
155	// added rule so could have one rule for main() to call for attempting
156	// to match a function subprogram. the original rule,
157	// external_subprogram, has (prefix)? for a function_subprogram.
158	ext_function_subprogram
159	@init{boolean hasPrefix=false;}
160	: (prefix {hasPrefix=true;})? function_subprogram
161	{action.ext_function_subprogram(hasPrefix);}
162	;
163
164	// R204
165	// ERR_CHK 204 see ERR_CHK 207, implicit_part? removed (was after import_stmt*)
166	specification_part
167	@init{int numUseStmts=0; int numImportStmts=0; int numDeclConstructs=0;}
168	: ( use_stmt {numUseStmts++;})*
169	( import_stmt {numImportStmts++;})*
170	( declaration_construct {numDeclConstructs++;})*
171	{action.specification_part(numUseStmts, numImportStmts,
172	0, numDeclConstructs);}
173	;
174
175	// R205 implicit_part removed from grammar (see ERR_CHK 207)
176
177	// R206 implicit_part_stmt removed from grammar (see ERR_CHK 207)
178
179	// R207
180	// ERR_CHK 207 implicit_stmt must precede all occurences of rules following
181	// it in text below
182	// has been removed from grammar so must be done when reducing
183	declaration_construct
184	@after {
185	action.declaration_construct();
186	}
187	: entry_stmt
188	\| parameter_stmt
189	\| format_stmt
190	\| implicit_stmt
191	// implicit_stmt must precede all occurences of the below
192	\| derived_type_def
193	\| enum_def
194	\| interface_block
195	\| procedure_declaration_stmt
196	\| specification_stmt
197	\| type_declaration_stmt
198	\| stmt_function_stmt
199	;
200
201	// R208
202	execution_part
203	@after {
204	action.execution_part();
205	}
206	: executable_construct
207	( execution_part_construct )*
208	;
209
210	// R209
211	execution_part_construct
212	@after {
213	action.execution_part_construct();
214	}
215	: executable_construct
216	\| format_stmt
217	\| entry_stmt
218	\| data_stmt
219	;
220
221	// R210
222	internal_subprogram_part
223	@init{int count = 1;}
224	: contains_stmt
225	internal_subprogram
226	(internal_subprogram {count += 1;})*
227	{ action.internal_subprogram_part(count); }
228	;
229
230	// R211
231	// modified to factor optional prefix
232	internal_subprogram
233	@after {
234	action.internal_subprogram();
235	}
236	: ( prefix )? function_subprogram
237	\| subroutine_subprogram
238	;
239
240	// R212
241	specification_stmt
242	@after {
243	action.specification_stmt();
244	checkForInclude();
245	}
246	: access_stmt
247	\| allocatable_stmt
248	\| asynchronous_stmt
249	\| bind_stmt
250	\| common_stmt
251	\| data_stmt
252	\| dimension_stmt
253	\| equivalence_stmt
254	\| external_stmt
255	\| intent_stmt
256	\| intrinsic_stmt
257	\| namelist_stmt
258	\| optional_stmt
259	\| pointer_stmt
260	\| protected_stmt
261	\| save_stmt
262	\| target_stmt
263	\| volatile_stmt
264	\| value_stmt
265	;
266
267	// R213
268	executable_construct
269	@after {
270	action.executable_construct();
271	}
272	: action_stmt
273	\| associate_construct
274	\| case_construct
275	\| do_construct
276	\| forall_construct
277	\| if_construct
278	\| select_type_construct
279	\| where_construct
280	;
281
282
283	// R214
284	// C201 (R208) An execution-part shall not contain an end-function-stmt, end-program-stmt, or
285	// end-subroutine-stmt. (But they can be in a branch target statement, which
286	// is not in the grammar, so the end-xxx-stmts deleted.)
287	// TODO continue-stmt is ambiguous with same in end-do, check for label and if
288	// label matches do-stmt label, then match end-do there
289	// the original generated rules do not allow the label, so add (label)?
290	action_stmt
291	@after {
292	action.action_stmt();
293	checkForInclude();
294	}
295	// Removed backtracking by inserting extra tokens in the stream by the
296	// prepass that signals whether we have an assignment-stmt, a
297	// pointer-assignment-stmt, or an arithmetic if. this approach may work for
298	// other parts of backtracking also. however, need to see if there is a way
299	// to define tokens w/o defining them in the lexer so that the lexer doesn't
300	// have to add them to it's parsing.. 02.05.07
301	: allocate_stmt
302	\| assignment_stmt
303	\| backspace_stmt
304	\| call_stmt
305	\| close_stmt
306	\| continue_stmt
307	\| cycle_stmt
308	\| deallocate_stmt
309	\| endfile_stmt
310	\| exit_stmt
311	\| flush_stmt
312	\| forall_stmt
313	\| goto_stmt
314	\| if_stmt
315	\| inquire_stmt
316	\| nullify_stmt
317	\| open_stmt
318	\| pointer_assignment_stmt
319	\| print_stmt
320	\| read_stmt
321	\| return_stmt
322	\| rewind_stmt
323	\| stop_stmt
324	\| wait_stmt
325	\| where_stmt
326	\| write_stmt
327	\| arithmetic_if_stmt
328	\| computed_goto_stmt
329	\| assign_stmt
330	\| assigned_goto_stmt
331	\| pause_stmt
332	;
333
334
335	// R215
336	keyword returns [Token tk]
337	@after {
338	action.keyword();
339	}
340	: name {tk = $name.tk;}
341	;
342
343	/*
344	Section 3:
345	*/
346
347	// R301 character not used
348
349	// R302 alphanumeric_character converted to fragment
350
351	// R303 underscore inlined
352
353	// R304
354	name returns [Token tk]
355	: T_IDENT { tk = $T_IDENT; action.name(tk); }
356	;
357
358	// R305
359	// ERR_CHK 305 named_constant replaced by T_IDENT
360	constant
361	: literal_constant { action.constant(null); }
362	\| T_IDENT { action.constant($T_IDENT); }
363	;
364
365	scalar_constant
366	@after {
367	action.scalar_constant();
368	}
369	: constant
370	;
371
372	// R306
373	literal_constant
374	@after {
375	action.literal_constant();
376	}
377	: int_literal_constant
378	\| real_literal_constant
379	\| complex_literal_constant
380	\| logical_literal_constant
381	\| char_literal_constant
382	\| boz_literal_constant
383	;
384
385	// R307 named_constant was name inlined as T_IDENT
386
387	// R308
388	// C302 R308 int_constant shall be of type integer
389	// inlined integer portion of constant
390	int_constant
391	: int_literal_constant { action.int_constant(null); }
392	\| T_IDENT { action.int_constant($T_IDENT); }
393	;
394
395	// R309
396	// C303 R309 char_constant shall be of type character
397	// inlined character portion of constant
398	char_constant
399	: char_literal_constant { action.int_constant(null); }
400	\| T_IDENT { action.int_constant($T_IDENT); }
401	;
402
403	// R310
404	intrinsic_operator returns [Token tk]
405	@after {
406	action.intrinsic_operator();
407	}
408	: power_op { tk = $power_op.tk; }
409	\| mult_op { tk = $mult_op.tk; }
410	\| add_op { tk = $add_op.tk; }
411	\| concat_op { tk = $concat_op.tk; }
412	\| rel_op { tk = $rel_op.tk; }
413	\| not_op { tk = $not_op.tk; }
414	\| and_op { tk = $and_op.tk; }
415	\| or_op { tk = $or_op.tk; }
416	\| equiv_op { tk = $equiv_op.tk; }
417	;
418
419	// R311
420	// removed defined_unary_op or defined_binary_op ambiguity with T_DEFINED_OP
421	defined_operator
422	: T_DEFINED_OP
423	{ action.defined_operator($T_DEFINED_OP, false); }
424	\| extended_intrinsic_op
425	{ action.defined_operator($extended_intrinsic_op.tk, true); }
426	;
427
428	// R312
429	extended_intrinsic_op returns [Token tk]
430	@after {
431	action.extended_intrinsic_op();
432	}
433	: intrinsic_operator { tk = $intrinsic_operator.tk; }
434	;
435
436	// R313
437	// ERR_CHK 313 five characters or less
438	label returns [Token tk]
439	: T_DIGIT_STRING { tk = $T_DIGIT_STRING; action.label($T_DIGIT_STRING); }
440	;
441
442	// action.label called here to store label in action class
443	label_list
444	@init{ int count=0;}
445	: {action.label_list__begin();}
446	lbl=label {count++;}
447	( T_COMMA lbl=label {count++;} )*
448	{action.label_list(count);}
449	;
450
451	/*
452	Section 4:
453	*/
454
455	// R401
456	type_spec
457	@after {
458	action.type_spec();
459	}
460	: intrinsic_type_spec
461	\| derived_type_spec
462	;
463
464	// R402
465	// ERR_CHK 402 scalar_int_expr replaced by expr
466	type_param_value
467	: expr { action.type_param_value(true, false, false); }
468	\| T_ASTERISK { action.type_param_value(false, true, false); }
469	\| T_COLON { action.type_param_value(false, false, true); }
470	;
471
472	// inlined scalar_int_expr C101 shall be a scalar
473
474	// inlined scalar_expr
475
476	// R403
477	// Nonstandard Extension: source BLAS
478	// \| T_DOUBLE T_COMPLEX
479	// \| T_DOUBLECOMPLEX
480	intrinsic_type_spec
481	@init{boolean hasKindSelector = false;}
482	: T_INTEGER (kind_selector {hasKindSelector = true;})?
483	{action.intrinsic_type_spec($T_INTEGER, null,
484	IActionEnums.IntrinsicTypeSpec_INTEGER,
485	hasKindSelector);}
486	\| T_REAL (kind_selector {hasKindSelector = true;})?
487	{action.intrinsic_type_spec($T_REAL, null,
488	IActionEnums.IntrinsicTypeSpec_REAL,
489	hasKindSelector);}
490	\| T_DOUBLE T_PRECISION
491	{action.intrinsic_type_spec($T_DOUBLE, $T_PRECISION,
492	IActionEnums.
493	IntrinsicTypeSpec_DOUBLEPRECISION,
494	false);}
495	\| T_DOUBLEPRECISION
496	{action.intrinsic_type_spec($T_DOUBLEPRECISION, null,
497	IActionEnums.
498	IntrinsicTypeSpec_DOUBLEPRECISION,
499	false);}
500	\| T_COMPLEX (kind_selector {hasKindSelector = true;})?
501	{action.intrinsic_type_spec($T_COMPLEX, null,
502	IActionEnums.IntrinsicTypeSpec_COMPLEX,
503	hasKindSelector);}
504	\| T_DOUBLE T_COMPLEX
505	{action.intrinsic_type_spec($T_DOUBLE, $T_COMPLEX,
506	IActionEnums.
507	IntrinsicTypeSpec_DOUBLECOMPLEX,
508	false);}
509	\| T_DOUBLECOMPLEX
510	{action.intrinsic_type_spec($T_DOUBLECOMPLEX, null,
511	IActionEnums.
512	IntrinsicTypeSpec_DOUBLECOMPLEX,
513	false);}
514	\| T_CHARACTER (char_selector {hasKindSelector = true;})?
515	{action.intrinsic_type_spec($T_CHARACTER, null,
516	IActionEnums.
517	IntrinsicTypeSpec_CHARACTER,
518	hasKindSelector);}
519	\| T_LOGICAL (kind_selector {hasKindSelector = true;})?
520	{action.intrinsic_type_spec($T_LOGICAL, null,
521	IActionEnums.IntrinsicTypeSpec_LOGICAL,
522	hasKindSelector);}
523	;
524
525	// R404
526	// ERR_CHK 404 scalar_int_initialization_expr replaced by expr
527	// Nonstandard extension: source common practice
528	// \| T_ASTERISK T_DIGIT_STRING // e.g., COMPLEX*16
529	// TODO - check to see if second alternative is where it should go
530	kind_selector
531	@init{Token tk1=null; Token tk2=null;}
532	: T_LPAREN (T_KIND T_EQUALS {tk1=$T_KIND; tk2=$T_EQUALS;})? expr T_RPAREN
533	{ action.kind_selector(tk1, tk2, true); }
534	\| T_ASTERISK T_DIGIT_STRING
535	{ action.kind_selector($T_ASTERISK, $T_DIGIT_STRING, false); }
536	;
537
538	// R405
539	signed_int_literal_constant
540	@init{Token sign = null;}
541	: (T_PLUS {sign=$T_PLUS;} \| T_MINUS {sign=$T_MINUS;})?
542	int_literal_constant
543	{ action.signed_int_literal_constant(sign); }
544	;
545
546	// R406
547	int_literal_constant
548	@init{Token kind = null;}
549	: T_DIGIT_STRING (T_UNDERSCORE kind_param {kind = $kind_param.tk;})?
550	{action.int_literal_constant($T_DIGIT_STRING, kind);}
551	;
552
553	// R407
554	// T_IDENT inlined for scalar_int_constant_name
555	kind_param returns [Token tk]
556	: T_DIGIT_STRING
557	{ tk = $T_DIGIT_STRING; action.kind_param($T_DIGIT_STRING); }
558	\| T_IDENT
559	{ tk = $T_IDENT; action.kind_param($T_IDENT); }
560	;
561
562	// R408 signed_digit_string inlined
563
564	// R409 digit_string converted to fragment
565
566	// R410 sign inlined
567
568	// R411
569	boz_literal_constant
570	: BINARY_CONSTANT { action.boz_literal_constant($BINARY_CONSTANT); }
571	\| OCTAL_CONSTANT { action.boz_literal_constant($OCTAL_CONSTANT); }
572	\| HEX_CONSTANT { action.boz_literal_constant($HEX_CONSTANT); }
573	;
574
575	// R412 binary-constant converted to terminal
576
577	// R413 octal_constant converted to terminal
578
579	// R414 hex_constant converted to terminal
580
581	// R415 hex_digit inlined
582
583	// R416
584	signed_real_literal_constant
585	@init{Token sign = null;}
586	: (T_PLUS {sign=$T_PLUS;} \| T_MINUS {sign=$T_MINUS;})?
587	real_literal_constant
588	{action.signed_real_literal_constant(sign);}
589	;
590
591	// R417 modified to use terminal
592	// Grammar Modified slightly to prevent problems with input such as:
593	// if(1.and.1) then ...
594	real_literal_constant
595	@init{Token kind = null;}
596	// WARNING must parse T_REAL_CONSTANT in action (look for D)
597	: T_REAL_CONSTANT (T_UNDERSCORE kind_param {kind = $kind_param.tk;})?
598	{ action.real_literal_constant($T_REAL_CONSTANT, kind); }
599
600	;
601
602	// R418 significand converted to fragment
603
604	// R419 exponent_letter inlined in new Exponent
605
606	// R420 exponent inlined in new Exponent
607
608	// R421
609	complex_literal_constant
610	@after {
611	action.complex_literal_constant();
612	}
613	: T_LPAREN real_part T_COMMA imag_part T_RPAREN
614	;
615
616	// R422
617	// ERR_CHK 422 named_constant replaced by T_IDENT
618	real_part
619	: signed_int_literal_constant
620	{ action.real_part(true, false, null); }
621	\| signed_real_literal_constant
622	{ action.real_part(false, true, null); }
623	\| T_IDENT
624	{ action.real_part(false, false, $T_IDENT); }
625	;
626
627	// R423
628	// ERR_CHK 423 named_constant replaced by T_IDENT
629	imag_part
630	: signed_int_literal_constant
631	{ action.imag_part(true, false, null); }
632	\| signed_real_literal_constant
633	{ action.imag_part(false, true, null); }
634	\| T_IDENT
635	{ action.imag_part(false, false, $T_IDENT); }
636	;
637
638	// R424
639	// ERR_CHK 424a scalar_int_initialization_expr replaced by expr
640	// ERR_CHK 424b T_KIND, if type_param_value, must be a
641	// scalar_int_initialization_expr
642	// ERR_CHK 424c T_KIND and T_LEN cannot both be specified
643	char_selector
644	@init {
645	int kindOrLen1; kindOrLen1 = IActionEnums.KindLenParam_none;
646	int kindOrLen2; kindOrLen2 = IActionEnums.KindLenParam_none;
647	Token tk1 = null;
648	Token tk2 = null;
649	boolean hasAsterisk = false;
650	}
651	: T_ASTERISK char_length (T_COMMA)?
652	{ hasAsterisk=true;
653	action.char_selector(tk1, tk2, kindOrLen1, kindOrLen2,
654	hasAsterisk); }
655	\| T_LPAREN (tmp1=T_KIND { kindOrLen1=IActionEnums.KindLenParam_kind;
656	tk1=tmp1; }
657	\| tmp1=T_LEN { kindOrLen1=IActionEnums.KindLenParam_len;
658	tk1=tmp1; })
659	T_EQUALS type_param_value
660	{ action.char_selector(tk1, tk2, kindOrLen1, kindOrLen2,
661	hasAsterisk); }
662	( T_COMMA (tmp2=T_KIND { kindOrLen2=IActionEnums.KindLenParam_kind;
663	tk2=tmp2; }
664	\| tmp2=T_LEN { kindOrLen2=IActionEnums.KindLenParam_len;
665	tk2=tmp2; })
666	T_EQUALS type_param_value )?
667	T_RPAREN
668	{ action.char_selector(tk1, tk2, kindOrLen1, kindOrLen2,
669	hasAsterisk); }
670	\| T_LPAREN type_param_value
671	(T_COMMA (tmp3=T_KIND T_EQUALS { tk2=tmp3; })? expr
672	{ kindOrLen2=IActionEnums.KindLenParam_kind;
673	action.type_param_value(true, false, false);} )?
674	T_RPAREN
675	{ action.char_selector(tk1, tk2, IActionEnums.KindLenParam_len,
676	kindOrLen2, hasAsterisk); }
677	;
678
679	// R425
680	length_selector
681	@init {
682	Token len = null;
683	}
684	: T_LPAREN ( T_LEN { len=$T_LEN; } T_EQUALS )? type_param_value T_RPAREN
685	{ action.length_selector(len, IActionEnums.KindLenParam_len,
686	false); }
687	\| T_ASTERISK char_length (T_COMMA)?
688	{ action.length_selector(len, IActionEnums.KindLenParam_none,
689	true); }
690	;
691
692	// R426
693	char_length
694	: T_LPAREN type_param_value T_RPAREN
695	{ action.char_length(true); }
696	\| scalar_int_literal_constant
697	{ action.char_length(false); }
698	;
699
700	scalar_int_literal_constant
701	@after {
702	action.scalar_int_literal_constant();
703	}
704	: int_literal_constant
705	;
706
707	// R427
708	// char_literal_constant
709	// // options {k=2;}
710	// : T_DIGIT_STRING T_UNDERSCORE T_CHAR_CONSTANT
711	// // removed the T_UNDERSCORE because underscores are valid characters
712	// // for identifiers, which means the lexer would match the T_IDENT and
713	// // T_UNDERSCORE as one token (T_IDENT).
714	// \| T_IDENT T_CHAR_CONSTANT
715	// \| T_CHAR_CONSTANT
716	// ;
717	char_literal_constant
718	: T_DIGIT_STRING T_UNDERSCORE T_CHAR_CONSTANT
719	{ action.char_literal_constant($T_DIGIT_STRING, null,
720	$T_CHAR_CONSTANT); }
721	// removed the T_UNDERSCORE because underscores are valid characters
722	// for identifiers, which means the lexer would match the T_IDENT and
723	// T_UNDERSCORE as one token (T_IDENT).
724	\| T_IDENT T_CHAR_CONSTANT
725	{ action.char_literal_constant(null, $T_IDENT, $T_CHAR_CONSTANT); }
726	\| T_CHAR_CONSTANT
727	{ action.char_literal_constant(null, null, $T_CHAR_CONSTANT); }
728	;
729
730	// R428
731	logical_literal_constant
732	@init{Token kind = null;}
733	: T_TRUE ( T_UNDERSCORE kind_param {kind = $kind_param.tk;})?
734	{action.logical_literal_constant($T_TRUE, true, kind);}
735	\| T_FALSE ( T_UNDERSCORE kind_param {kind = $kind_param.tk;})?
736	{action.logical_literal_constant($T_FALSE, false, kind);}
737	;
738
739	// R429
740	// ( component_part )? inlined as ( component_def_stmt )*
741	derived_type_def
742	@after {
743	action.derived_type_def();
744	}
745	: derived_type_stmt
746	// matches T_INTEGER possibilities in component_def_stmt
747	type_param_or_comp_def_stmt_list
748	( private_or_sequence )*
749	{ /* ERR_CHK 429
750	* if private_or_sequence present, component_def_stmt in
751	* type_param_or_comp_def_stmt_list
752	* is an error
753	*/
754	}
755	( component_def_stmt )*
756	( type_bound_procedure_part )?
757	end_type_stmt
758	;
759
760	// Includes:
761	// ( type_param_def_stmt)*
762	// ( component_def_stmt )* if starts with T_INTEGER (could be a parse error)
763	// REMOVED T_INTEGER junk (see statement above) with k=1
764	// TODO this must be tested can we get rid of this????
765	type_param_or_comp_def_stmt_list
766	@after {
767	action.type_param_or_comp_def_stmt_list();
768	}
769	///options {k=1;}
770	// : (T_INTEGER) => (kind_selector)? T_COMMA type_param_or_comp_def_stmt
771	// type_param_or_comp_def_stmt_list
772	: (kind_selector)? T_COMMA type_param_or_comp_def_stmt
773	type_param_or_comp_def_stmt_list
774	\|
775	{ /* ERR_CHK R435
776	* type_param_def_stmt(s) must precede component_def_stmt(s)
777	*/
778	}
779	;
780
781	type_param_or_comp_def_stmt
782	: type_param_attr_spec T_COLON_COLON type_param_decl_list end_of_stmt
783	// TODO: See if this is reachable now that type_param_attr_spec is
784	// tokenized T_KIND or T_LEN. See R435
785	{action.type_param_or_comp_def_stmt($end_of_stmt.tk,
786	IActionEnums.TypeParamOrCompDef_typeParam);}
787	\| component_attr_spec_list T_COLON_COLON component_decl_list end_of_stmt
788	// See R440
789	{action.type_param_or_comp_def_stmt($end_of_stmt.tk,
790	IActionEnums.TypeParamOrCompDef_compDef);}
791	;
792
793	// R430
794	// generic_name_list substituted for type_param_name_list
795	derived_type_stmt
796	@init {
797	Token lbl=null;
798	boolean hasTypeAttrSpecList=false;
799	boolean hasGenericNameList=false;
800	}
801	@after{checkForInclude();}
802	: (label {lbl=$label.tk;})? T_TYPE
803	( ( T_COMMA type_attr_spec_list {hasTypeAttrSpecList=true;} )?
804	T_COLON_COLON )? T_IDENT
805	( T_LPAREN generic_name_list T_RPAREN {hasGenericNameList=true;} )?
806	end_of_stmt
807	{action.derived_type_stmt(lbl, $T_TYPE, $T_IDENT, $end_of_stmt.tk,
808	hasTypeAttrSpecList, hasGenericNameList);}
809	;
810
811	type_attr_spec_list
812	@init{int count = 0;}
813	: {action.type_attr_spec_list__begin();}
814	type_attr_spec {count++;} ( T_COMMA type_attr_spec {count++;} )*
815	{action.type_attr_spec_list(count);}
816	;
817
818	generic_name_list
819	@init{int count = 0;}
820	: {action.generic_name_list__begin();}
821	ident=T_IDENT
822	{
823	count++;
824	action.generic_name_list_part(ident);
825	} ( T_COMMA ident=T_IDENT
826	{
827	count++;
828	action.generic_name_list_part(ident);
829	} )*
830	{action.generic_name_list(count);}
831	;
832
833	// R431
834	// T_IDENT inlined for parent_type_name
835	type_attr_spec
836	: access_spec
837	{action.type_attr_spec(null, null,
838	IActionEnums.TypeAttrSpec_access_spec);}
839	\| T_EXTENDS T_LPAREN T_IDENT T_RPAREN
840	{action.type_attr_spec($T_EXTENDS, $T_IDENT,
841	IActionEnums.TypeAttrSpec_extends);}
842	\| T_ABSTRACT
843	{action.type_attr_spec($T_ABSTRACT, null,
844	IActionEnums.TypeAttrSpec_abstract);}
845	\| T_BIND T_LPAREN T_IDENT /* 'C' */ T_RPAREN
846	{action.type_attr_spec($T_BIND, $T_IDENT,
847	IActionEnums.TypeAttrSpec_bind);}
848	;
849
850	// R432
851	private_or_sequence
852	@after {
853	action.private_or_sequence();
854	}
855	: private_components_stmt
856	\| sequence_stmt
857	;
858
859	// R433
860	end_type_stmt
861	@init {Token lbl = null;Token id=null;}
862	@after{checkForInclude();}
863	: (label {lbl=$label.tk;})? T_END T_TYPE ( T_IDENT {id=$T_IDENT;})?
864	end_of_stmt
865	{action.end_type_stmt(lbl, $T_END, $T_TYPE, id, $end_of_stmt.tk);}
866	\| (label {lbl=$label.tk;})? T_ENDTYPE ( T_IDENT {id=$T_IDENT;})?
867	end_of_stmt
868	{action.end_type_stmt(lbl, $T_ENDTYPE, null, id, $end_of_stmt.tk);}
869	;
870
871	// R434
872	sequence_stmt
873	@init {Token lbl = null;}
874	@after{checkForInclude();}
875	: (label {lbl=$label.tk;})? T_SEQUENCE end_of_stmt
876	{action.sequence_stmt(lbl, $T_SEQUENCE, $end_of_stmt.tk);}
877	;
878
879	// R435 type_param_def_stmt inlined in type_param_or_comp_def_stmt_list
880
881	// R436
882	// ERR_CHK 436 scalar_int_initialization_expr replaced by expr
883	// T_IDENT inlined for type_param_name
884	type_param_decl
885	@init{ boolean hasInit=false; }
886	: T_IDENT ( T_EQUALS expr {hasInit=true;})?
887	{action.type_param_decl($T_IDENT, hasInit);}
888	;
889
890	type_param_decl_list
891	@init{int count=0;}
892	: {action.type_param_decl_list__begin();}
893	type_param_decl {count++;} ( T_COMMA type_param_decl {count++;} )*
894	{action.type_param_decl_list(count);}
895	;
896
897	// R437
898	// ADD isKind boolean.
899	type_param_attr_spec
900	: T_IDENT /* { KIND \| LEN } */
901	{ action.type_param_attr_spec($T_IDENT); }
902	;
903
904	// R438 component_part inlined as ( component_def_stmt )* in R429
905
906	// R439
907	component_def_stmt
908	@after{checkForInclude();}
909	: data_component_def_stmt
910	{action.component_def_stmt(IActionEnums.ComponentDefType_data);}
911	\| proc_component_def_stmt
912	{action.component_def_stmt(IActionEnums.
913	ComponentDefType_procedure);}
914	;
915
916
917	// R440
918	data_component_def_stmt
919	@init {Token lbl = null; boolean hasSpec=false; }
920	@after{checkForInclude();}
921	: (label {lbl=$label.tk;})? declaration_type_spec
922	( ( T_COMMA component_attr_spec_list {hasSpec=true;})?
923	T_COLON_COLON )? component_decl_list end_of_stmt
924	{action.data_component_def_stmt(lbl, $end_of_stmt.tk, hasSpec);}
925	;
926
927	// R441, R442-F2008
928	// TODO it appears there is a bug in the standard for a parameterized type,
929	// it needs to accept KIND, LEN keywords, see NOTE 4.24 and 4.25
930	component_attr_spec
931	: T_POINTER
932	{action.component_attr_spec($T_POINTER,
933	IActionEnums.ComponentAttrSpec_pointer);}
934	\| T_DIMENSION T_LPAREN component_array_spec T_RPAREN
935	{action.component_attr_spec($T_DIMENSION,
936	IActionEnums.ComponentAttrSpec_dimension);}
937	\| T_ALLOCATABLE
938	{action.component_attr_spec($T_ALLOCATABLE,
939	IActionEnums.ComponentAttrSpec_allocatable);}
940	\| access_spec
941	{action.component_attr_spec(null,
942	IActionEnums.ComponentAttrSpec_access_spec);}
943	// are T_KIND and T_LEN correct?
944	\| T_KIND
945	{action.component_attr_spec($T_KIND,
946	IActionEnums.ComponentAttrSpec_kind);}
947	\| T_LEN
948	{action.component_attr_spec($T_LEN,
949	IActionEnums.ComponentAttrSpec_len);}
950	;
951
952	component_attr_spec_list
953	@init{int count=1;}
954	: {action.component_attr_spec_list__begin();}
955	component_attr_spec ( T_COMMA component_attr_spec {count++;} )*
956	{action.component_attr_spec_list(count);}
957	;
958
959	// R442, R443-F2008
960	// T_IDENT inlined as component_name
961	component_decl
962	@init {
963	boolean hasComponentArraySpec = false;
964	boolean hasCoarraySpec = false;
965	boolean hasCharLength = false;
966	boolean hasComponentInitialization = false;
967	}
968	: T_IDENT ( T_LPAREN component_array_spec T_RPAREN
969	{hasComponentArraySpec=true;})?
970	( T_ASTERISK char_length {hasCharLength=true;})?
971	( component_initialization {hasComponentInitialization =true;})?
972	{ action.component_decl($T_IDENT, hasComponentArraySpec,
973	hasCoarraySpec, hasCharLength,
974	hasComponentInitialization);}
975	;
976
977	component_decl_list
978	@init{int count=0;}
979	: {action.component_decl_list__begin();}
980	component_decl {count++;} ( T_COMMA component_decl {count++;} )*
981	{action.component_decl_list(count);}
982	;
983
984	// R443
985	component_array_spec
986	: explicit_shape_spec_list
987	{action.component_array_spec(true);}
988	\| deferred_shape_spec_list
989	{action.component_array_spec(false);}
990	;
991
992	// deferred_shape_spec replaced by T_COLON
993	deferred_shape_spec_list
994	@init{int count=0;}
995	: {action.deferred_shape_spec_list__begin();}
996	T_COLON {count++;} ( T_COMMA T_COLON {count++;} )*
997	{action.deferred_shape_spec_list(count);}
998	;
999
1000	// R444
1001	// R447-F2008 can also be => initial_data_target, see NOTE 4.40 in J3/07-007
1002	// ERR_CHK 444 initialization_expr replaced by expr
1003	component_initialization
1004	@after {
1005	action.component_initialization();
1006	}
1007	: T_EQUALS expr
1008	\| T_EQ_GT null_init
1009	;
1010
1011	// R445
1012	proc_component_def_stmt
1013	@init {Token lbl = null; boolean hasInterface=false;}
1014	@after{checkForInclude();}
1015	: (label {lbl=$label.tk;})? T_PROCEDURE T_LPAREN
1016	( proc_interface {hasInterface=true;})? T_RPAREN T_COMMA
1017	proc_component_attr_spec_list T_COLON_COLON proc_decl_list
1018	end_of_stmt
1019	{action.proc_component_def_stmt(lbl, $T_PROCEDURE,
1020	$end_of_stmt.tk, hasInterface);}
1021	;
1022
1023	// R446
1024	// T_IDENT inlined for arg_name
1025	proc_component_attr_spec
1026	@init{ Token id=null; }
1027	: T_POINTER
1028	{action.proc_component_attr_spec($T_POINTER, id,
1029	IActionEnums.
1030	ProcComponentAttrSpec_pointer);}
1031	\| T_PASS ( T_LPAREN T_IDENT T_RPAREN {id=$T_IDENT;} )?
1032	{action.proc_component_attr_spec($T_PASS, id,
1033	IActionEnums.
1034	ProcComponentAttrSpec_pass);}
1035	\| T_NOPASS
1036	{action.proc_component_attr_spec($T_NOPASS, id,
1037	IActionEnums.
1038	ProcComponentAttrSpec_nopass);}
1039	\| access_spec
1040	{action.
1041	proc_component_attr_spec(null, id,
1042	IActionEnums.
1043	ProcComponentAttrSpec_access_spec);}
1044	;
1045
1046	proc_component_attr_spec_list
1047	@init{int count=0;}
1048	: {action.proc_component_attr_spec_list__begin();}
1049	proc_component_attr_spec {count++;}
1050	( T_COMMA proc_component_attr_spec {count++;})*
1051	{action.proc_component_attr_spec_list(count);}
1052	;
1053
1054	// R447
1055	private_components_stmt
1056	@init {Token lbl = null;}
1057	@after{checkForInclude();}
1058	: (label {lbl=$label.tk;})? T_PRIVATE end_of_stmt
1059	{action.private_components_stmt(lbl, $T_PRIVATE, $end_of_stmt.tk);}
1060	;
1061
1062	// R448
1063	type_bound_procedure_part
1064	@init{int count=0; boolean hasBindingPrivateStmt = false;}
1065	: contains_stmt
1066	( binding_private_stmt {hasBindingPrivateStmt=true;})?
1067	proc_binding_stmt ( proc_binding_stmt {count++;})*
1068	{action.type_bound_procedure_part(count,
1069	hasBindingPrivateStmt);}
1070	;
1071
1072	// R449
1073	binding_private_stmt
1074	@init {Token lbl = null;}
1075	@after{checkForInclude();}
1076	: (label {lbl=$label.tk;})? T_PRIVATE end_of_stmt
1077	{action.binding_private_stmt(lbl, $T_PRIVATE, $end_of_stmt.tk);}
1078	;
1079
1080	// R450
1081	proc_binding_stmt
1082	@init {Token lbl = null;}
1083	@after{checkForInclude();}
1084	: (label {lbl=$label.tk;})? specific_binding end_of_stmt
1085	{action.proc_binding_stmt(lbl,
1086	IActionEnums.BindingStatementType_specific, $end_of_stmt.tk);}
1087	\| (label {lbl=$label.tk;})? generic_binding end_of_stmt
1088	{action.proc_binding_stmt(lbl,
1089	IActionEnums.BindingStatementType_generic, $end_of_stmt.tk);}
1090	\| (label {lbl=$label.tk;})? final_binding end_of_stmt
1091	{action.proc_binding_stmt(lbl,
1092	IActionEnums.BindingStatementType_final, $end_of_stmt.tk);}
1093	;
1094
1095	// R451
1096	// T_IDENT inlined for interface_name, binding_name and procedure_name
1097	specific_binding
1098	@init {
1099	Token interfaceName=null;
1100	Token bindingName=null;
1101	Token procedureName=null;
1102	boolean hasBindingAttrList=false;
1103	}
1104	: T_PROCEDURE (T_LPAREN tmpId1=T_IDENT T_RPAREN {interfaceName=tmpId1;})?
1105	( ( T_COMMA binding_attr_list {hasBindingAttrList=true;})?
1106	T_COLON_COLON )?
1107	tmpId2=T_IDENT {bindingName=tmpId2;}
1108	( T_EQ_GT tmpId3=T_IDENT {procedureName=tmpId3;})?
1109	{ action.specific_binding($T_PROCEDURE, interfaceName, bindingName,
1110	procedureName, hasBindingAttrList);}
1111	;
1112
1113	// R452
1114	// generic_name_list substituted for binding_name_list
1115	generic_binding
1116	@init{boolean hasAccessSpec=false;}
1117	: T_GENERIC ( T_COMMA access_spec {hasAccessSpec=true;})? T_COLON_COLON
1118	generic_spec T_EQ_GT generic_name_list
1119	{action.generic_binding($T_GENERIC, hasAccessSpec);}
1120	;
1121
1122	// R453
1123	// T_IDENT inlined for arg_name
1124	binding_attr
1125	@init{Token id = null;}
1126	: T_PASS ( T_LPAREN T_IDENT T_RPAREN {id=$T_IDENT;})?
1127	{ action.binding_attr($T_PASS, IActionEnums.AttrSpec_PASS, id); }
1128	\| T_NOPASS
1129	{ action.binding_attr($T_NOPASS, IActionEnums.AttrSpec_NOPASS, id); }
1130	\| T_NON_OVERRIDABLE
1131	{ action.binding_attr($T_NON_OVERRIDABLE,
1132	IActionEnums.AttrSpec_NON_OVERRIDABLE, id); }
1133	\| T_DEFERRED
1134	{ action.binding_attr($T_DEFERRED, IActionEnums.AttrSpec_DEFERRED,
1135	id); }
1136	\| access_spec
1137	{ action.binding_attr(null, IActionEnums.AttrSpec_none, id); }
1138	;
1139
1140	binding_attr_list
1141	@init{int count=0;}
1142	: {action.binding_attr_list__begin();}
1143	binding_attr {count++;} ( T_COMMA binding_attr {count++;} )*
1144	{action.binding_attr_list(count);}
1145	;
1146
1147	// R454
1148	// generic_name_list substituted for final_subroutine_name_list
1149	final_binding
1150	: T_FINAL ( T_COLON_COLON )? generic_name_list
1151	{ action.final_binding($T_FINAL); }
1152	;
1153
1154	// R455
1155	derived_type_spec
1156	@init{boolean hasList = false;}
1157	: T_IDENT ( T_LPAREN type_param_spec_list {hasList=true;} T_RPAREN )?
1158	{ action.derived_type_spec($T_IDENT, hasList); }
1159	;
1160
1161	// R456
1162	type_param_spec
1163	@init{ Token keyWord=null; }
1164	: ( keyword T_EQUALS {keyWord=$keyword.tk;})? type_param_value
1165	{action.type_param_spec(keyWord);}
1166	;
1167
1168	type_param_spec_list
1169	@init{int count=0;}
1170	: {action.type_param_spec_list__begin();}
1171	type_param_spec {count++;}( T_COMMA type_param_spec {count++;})*
1172	{action.type_param_spec_list(count);}
1173	;
1174
1175	// R457
1176	// inlined derived_type_spec (R662) to remove ambiguity using backtracking
1177	// ERR_CHK R457
1178	// If any of the type-param-specs in the list are an '*' or ':', the
1179	// component-spec-list is required.
1180	// the second alternative to the original rule for structure_constructor is
1181	// a subset of the first alternative because component_spec_list is a
1182	// subset of type_param_spec_list. by combining these two alternatives we can
1183	// remove the backtracking on this rule.
1184	structure_constructor
1185	// options {backtrack=true;}
1186	// : T_IDENT T_LPAREN type_param_spec_list T_RPAREN
1187	// T_LPAREN
1188	// ( component_spec_list )?
1189	// T_RPAREN
1190	// \| T_IDENT
1191	// T_LPAREN
1192	// ( component_spec_list )?
1193	// T_RPAREN
1194	: T_IDENT T_LPAREN type_param_spec_list T_RPAREN
1195	(T_LPAREN
1196	( component_spec_list )?
1197	T_RPAREN)?
1198	{ action.structure_constructor($T_IDENT); }
1199	;
1200
1201	// R458
1202	component_spec
1203	@init { Token keyWord = null; }
1204	: ( keyword T_EQUALS { keyWord=$keyword.tk; })? component_data_source
1205	{ action.component_spec(keyWord); }
1206	;
1207
1208	component_spec_list
1209	@init{int count=0;}
1210	: {action.component_spec_list__begin();}
1211	component_spec {count++;}( T_COMMA component_spec {count++;})*
1212	{action.component_spec_list(count);}
1213	;
1214
1215	// R459
1216	// is (expr \| data-target \| proc-target)
1217	// data_target isa expr so data_target deleted
1218	// proc_target isa expr so proc_target deleted
1219	component_data_source
1220	: expr
1221	{ action.component_data_source(); }
1222	;
1223
1224	// R460
1225	enum_def
1226	@init{ int numEls=1; }
1227	: enum_def_stmt
1228	enumerator_def_stmt
1229	( enumerator_def_stmt {numEls++;})*
1230	end_enum_stmt
1231	{action.enum_def(numEls);}
1232	;
1233
1234	// R461
1235	enum_def_stmt
1236	@init {Token lbl = null;}
1237	@after{checkForInclude();}
1238	: (label {lbl=$label.tk;})? T_ENUM T_COMMA T_BIND T_LPAREN
1239	T_IDENT /* 'C' */ T_RPAREN end_of_stmt
1240	{action.enum_def_stmt(lbl, $T_ENUM, $T_BIND, $T_IDENT,
1241	$end_of_stmt.tk);}
1242	;
1243
1244	// R462
1245	enumerator_def_stmt
1246	@init {Token lbl = null;}
1247	@after{checkForInclude();}
1248	: (label {lbl=$label.tk;})? T_ENUMERATOR ( T_COLON_COLON )?
1249	enumerator_list end_of_stmt
1250	{action.enumerator_def_stmt(lbl, $T_ENUMERATOR, $end_of_stmt.tk);}
1251	;
1252
1253	// R463
1254	// ERR_CHK 463 scalar_int_initialization_expr replaced by expr
1255	// ERR_CHK 463 named_constant replaced by T_IDENT
1256	enumerator
1257	@init{boolean hasExpr = false;}
1258	: T_IDENT ( T_EQUALS expr { hasExpr = true; })?
1259	{ action.enumerator($T_IDENT, hasExpr); }
1260	;
1261
1262	enumerator_list
1263	@init{int count=0;}
1264	: {action.enumerator_list__begin();}
1265	enumerator {count++;}( T_COMMA enumerator {count++;})*
1266	{action.enumerator_list(count);}
1267	;
1268
1269	// R464
1270	end_enum_stmt
1271	@init {Token lbl = null;}
1272	@after{checkForInclude();}
1273	: (label {lbl=$label.tk;})? T_END T_ENUM end_of_stmt
1274	{ action.end_enum_stmt(lbl, $T_END, $T_ENUM, $end_of_stmt.tk); }
1275	\| (label {lbl=$label.tk;})? T_ENDENUM end_of_stmt
1276	{ action.end_enum_stmt(lbl, $T_ENDENUM, null, $end_of_stmt.tk); }
1277	;
1278
1279	// R465
1280	array_constructor
1281	: T_LPAREN T_SLASH ac_spec T_SLASH T_RPAREN
1282	{ action.array_constructor(); }
1283	\| T_LBRACKET ac_spec T_RBRACKET
1284	{ action.array_constructor(); }
1285	;
1286
1287	// R466
1288	// refactored to remove optional from lhs
1289	ac_spec
1290	options {backtrack=true;}
1291	@after {
1292	action.ac_spec();
1293	}
1294	: type_spec T_COLON_COLON (ac_value_list)?
1295	\| ac_value_list
1296	;
1297
1298	// R467 left_square_bracket inlined as T_LBRACKET
1299
1300	// R468 right_square_bracket inlined as T_RBRACKET
1301
1302	// R469
1303	ac_value
1304	options {backtrack=true;}
1305	@after {
1306	action.ac_value();
1307	}
1308	: expr
1309	\| ac_implied_do
1310	;
1311
1312	ac_value_list
1313	@init{int count=0;}
1314	: {action.ac_value_list__begin();}
1315	ac_value {count++;}( T_COMMA ac_value {count++;})*
1316	{action.ac_value_list(count);}
1317	;
1318
1319	// R470
1320	ac_implied_do
1321	: T_LPAREN ac_value_list T_COMMA ac_implied_do_control T_RPAREN
1322	{action.ac_implied_do();}
1323	;
1324
1325	// R471
1326	// ERR_CHK 471a scalar_int_expr replaced by expr
1327	// ERR_CHK 471b ac_do_variable replaced by scalar_int_variable replaced
1328	// by variable replaced by T_IDENT
1329	ac_implied_do_control
1330	@init{boolean hasStride=false;}
1331	: T_IDENT T_EQUALS expr T_COMMA expr ( T_COMMA expr {hasStride=true;})?
1332	{action.ac_implied_do_control(hasStride);}
1333	;
1334
1335	// R472 inlined ac_do_variable as scalar_int_variable (and finally T_IDENT)
1336	// in R471
1337	// C493 (R472) ac-do-variable shall be a named variable
1338	scalar_int_variable
1339	: variable
1340	{ action.scalar_int_variable(); }
1341	;
1342
1343
1344	/*
1345	Section 5:
1346	*/
1347
1348	// R501
1349	type_declaration_stmt
1350	@init {Token lbl = null; int numAttrSpecs = 0;}
1351	@after{checkForInclude();}
1352	: (label {lbl=$label.tk;})? declaration_type_spec
1353	( (T_COMMA attr_spec {numAttrSpecs += 1;})* T_COLON_COLON )?
1354	entity_decl_list end_of_stmt
1355	{ action.type_declaration_stmt(lbl, numAttrSpecs,
1356	$end_of_stmt.tk); }
1357	;
1358
1359	// R502
1360	declaration_type_spec
1361	: intrinsic_type_spec
1362	{ action.declaration_type_spec(null,
1363	IActionEnums.DeclarationTypeSpec_INTRINSIC); }
1364	\| T_TYPE T_LPAREN derived_type_spec T_RPAREN
1365	{ action.declaration_type_spec($T_TYPE,
1366	IActionEnums.DeclarationTypeSpec_TYPE); }
1367	\| T_CLASS T_LPAREN derived_type_spec T_RPAREN
1368	{ action.declaration_type_spec($T_CLASS,
1369	IActionEnums.DeclarationTypeSpec_CLASS); }
1370	\| T_CLASS T_LPAREN T_ASTERISK T_RPAREN
1371	{ action.declaration_type_spec($T_CLASS,
1372	IActionEnums.DeclarationTypeSpec_unlimited); }
1373	;
1374
1375	// R503
1376	attr_spec
1377	: access_spec { action.attr_spec(null,
1378	IActionEnums.AttrSpec_access); }
1379	\| T_ALLOCATABLE { action.attr_spec($T_ALLOCATABLE,
1380	IActionEnums.AttrSpec_ALLOCATABLE); }
1381	\| T_ASYNCHRONOUS { action.attr_spec($T_ASYNCHRONOUS,
1382	IActionEnums.AttrSpec_ASYNCHRONOUS); }
1383	\| T_DIMENSION T_LPAREN array_spec T_RPAREN
1384	{ action.attr_spec($T_DIMENSION,
1385	IActionEnums.AttrSpec_DIMENSION ); }
1386	\| T_EXTERNAL { action.attr_spec($T_EXTERNAL,
1387	IActionEnums.AttrSpec_EXTERNAL); }
1388	\| T_INTENT T_LPAREN intent_spec T_RPAREN
1389	{ action.attr_spec($T_INTENT,
1390	IActionEnums.AttrSpec_INTENT); }
1391	\| T_INTRINSIC { action.attr_spec($T_INTRINSIC,
1392	IActionEnums.AttrSpec_INTRINSIC); }
1393	\| language_binding_spec
1394	{ action.attr_spec(null,
1395	IActionEnums.AttrSpec_language_binding); }
1396	\| T_OPTIONAL { action.attr_spec($T_OPTIONAL,
1397	IActionEnums.AttrSpec_OPTIONAL); }
1398	\| T_PARAMETER { action.attr_spec($T_PARAMETER,
1399	IActionEnums.AttrSpec_PARAMETER); }
1400	\| T_POINTER { action.attr_spec($T_POINTER,
1401	IActionEnums.AttrSpec_POINTER); }
1402	\| T_PROTECTED { action.attr_spec($T_PROTECTED,
1403	IActionEnums.AttrSpec_PROTECTED); }
1404	\| T_SAVE { action.attr_spec($T_SAVE,
1405	IActionEnums.AttrSpec_SAVE); }
1406	\| T_TARGET { action.attr_spec($T_TARGET,
1407	IActionEnums.AttrSpec_TARGET); }
1408	\| T_VALUE { action.attr_spec($T_VALUE,
1409	IActionEnums.AttrSpec_VALUE); }
1410	\| T_VOLATILE { action.attr_spec($T_VOLATILE,
1411	IActionEnums.AttrSpec_VOLATILE); }
1412	// TODO are T_KIND and T_LEN correct?
1413	\| T_KIND
1414	{ action.attr_spec($T_KIND, IActionEnums.AttrSpec_KIND); }
1415	\| T_LEN
1416	{ action.attr_spec($T_LEN, IActionEnums.AttrSpec_LEN); }
1417	;
1418
1419
1420	// R504
1421	// T_IDENT inlined for object_name and function_name
1422	// T_IDENT ( T_ASTERISK char_length )? (second alt) subsumed in first alt
1423	// TODO Pass more info to action....
1424	entity_decl
1425	@init{
1426	boolean hasArraySpec=false;
1427	boolean hasCoarraySpec=false;
1428	boolean hasCharLength=false;
1429	boolean hasInitialization=false;
1430	}
1431	: T_IDENT ( T_LPAREN array_spec T_RPAREN {hasArraySpec=true;} )?
1432	( T_ASTERISK char_length {hasCharLength=true;} )?
1433	( initialization {hasInitialization=true;} )?
1434	{
1435	action.entity_decl($T_IDENT, hasArraySpec,
1436	hasCoarraySpec, hasCharLength, hasInitialization);
1437	}
1438	;
1439
1440	entity_decl_list
1441	@init{int count = 0;}
1442	: {action.entity_decl_list__begin();}
1443	entity_decl {count += 1;} ( T_COMMA entity_decl {count += 1;} )*
1444	{action.entity_decl_list(count);}
1445	;
1446
1447	/*
1448	* R505-F03 object-name
1449	* is name
1450	*/
1451
1452	////////////
1453	// R505-F03, R504-F08
1454	//
1455	object_name returns [Token tk]
1456	: T_IDENT {tk = $T_IDENT;}
1457	;
1458
1459	// R506
1460	// ERR_CHK 506 initialization_expr replaced by expr
1461	initialization
1462	: T_EQUALS expr { action.initialization(true, false); }
1463	\| T_EQ_GT null_init { action.initialization(false, true); }
1464	;
1465
1466	// R507
1467	// C506 The function-reference shall be a reference to the NULL intrinsic
1468	// function with no arguments.
1469	null_init
1470	: T_IDENT /* 'NULL' */ T_LPAREN T_RPAREN
1471	{ action.null_init($T_IDENT); }
1472	;
1473
1474	// R508
1475	access_spec
1476	: T_PUBLIC
1477	{action.access_spec($T_PUBLIC, IActionEnums.AttrSpec_PUBLIC);}
1478	\| T_PRIVATE
1479	{action.access_spec($T_PRIVATE, IActionEnums.AttrSpec_PRIVATE);}
1480	;
1481
1482	// R509
1483	// ERR_CHK 509 scalar_char_initialization_expr replaced by expr
1484	language_binding_spec
1485	@init{boolean hasName = false;}
1486	: T_BIND T_LPAREN T_IDENT /* 'C' */
1487	(T_COMMA name T_EQUALS expr {hasName=true;})? T_RPAREN
1488	{ action.language_binding_spec($T_BIND, $T_IDENT, hasName); }
1489	;
1490
1491	// R510
1492	array_spec
1493	@init{int count=0;}
1494	: array_spec_element {count++;}
1495	(T_COMMA array_spec_element {count++;})*
1496	{action.array_spec(count);}
1497	;
1498
1499	// Array specifications can consist of these beasts. Note that we can't
1500	// mix/match arbitrarily, so we have to check validity in actions.
1501	// Types: 0 expr (e.g. 3 or m+1)
1502	// 1 expr: (e.g. 3:)
1503	// 2 expr:expr (e.g. 3:5 or 7:(m+1))
1504	// 3 expr:* (e.g. 3:* end of assumed size)
1505	// 4 * (end of assumed size)
1506	// 5 : (could be part of assumed or deferred shape)
1507	array_spec_element
1508	@init{int type=IActionEnums.ArraySpecElement_expr;}
1509	: expr ( T_COLON {type=IActionEnums.ArraySpecElement_expr_colon;}
1510	( expr {type=IActionEnums.ArraySpecElement_expr_colon_expr;}
1511	\| T_ASTERISK
1512	{type=IActionEnums.ArraySpecElement_expr_colon_asterisk;} )?
1513	)?
1514	{ action.array_spec_element(type); }
1515	\| T_ASTERISK
1516	{ action.array_spec_element(IActionEnums.
1517	ArraySpecElement_asterisk); }
1518	\| T_COLON
1519	{ action.array_spec_element(IActionEnums.ArraySpecElement_colon); }
1520	;
1521
1522	// R511
1523	// refactored to remove conditional from lhs and inlined lower_bound and
1524	// upper_bound
1525	explicit_shape_spec
1526	@init{boolean hasUpperBound=false;}
1527	: expr (T_COLON expr {hasUpperBound=true;})?
1528	{action.explicit_shape_spec(hasUpperBound);}
1529	;
1530
1531	explicit_shape_spec_list
1532	@init{ int count=0;}
1533	: {action.explicit_shape_spec_list__begin();}
1534	explicit_shape_spec {count++;}
1535	( T_COMMA explicit_shape_spec {count++;})*
1536	{action.explicit_shape_spec_list(count);}
1537	;
1538
1539	// R512 lower_bound was specification_expr inlined as expr
1540
1541	// R513 upper_bound was specification_expr inlined as expr
1542
1543	// R514 assumed_shape_spec was ( lower_bound )? T_COLON not used in R510
1544	// array_spec
1545
1546	// R515 deferred_shape_spec inlined as T_COLON in deferred_shape_spec_list
1547
1548	// R516 assumed_size_spec absorbed into array_spec.
1549
1550	// R517
1551	intent_spec
1552	: T_IN { action.intent_spec($T_IN, null,
1553	IActionEnums.IntentSpec_IN); }
1554	\| T_OUT { action.intent_spec($T_OUT, null,
1555	IActionEnums.IntentSpec_OUT); }
1556	\| T_IN T_OUT { action.intent_spec($T_IN, $T_OUT,
1557	IActionEnums.IntentSpec_INOUT); }
1558	\| T_INOUT { action.intent_spec($T_INOUT, null,
1559	IActionEnums.IntentSpec_INOUT); }
1560	;
1561
1562	// R518
1563	access_stmt
1564	@init {Token lbl = null;boolean hasList=false;}
1565	@after{checkForInclude();}
1566	: (label {lbl=$label.tk;})? access_spec ( ( T_COLON_COLON )?
1567	access_id_list {hasList=true;})? end_of_stmt
1568	{ action.access_stmt(lbl,$end_of_stmt.tk,hasList); }
1569	;
1570
1571	// R519
1572	// T_IDENT inlined for use_name
1573	// generic_spec can be T_IDENT so T_IDENT deleted
1574	// TODO - can this only be T_IDENTS? generic_spec is more than that..
1575	access_id
1576	: generic_spec
1577	{ action.access_id(); }
1578	;
1579
1580	access_id_list
1581	@init{ int count=0;}
1582	: {action.access_id_list__begin();}
1583	access_id {count++;} ( T_COMMA access_id {count++;} )*
1584	{action.access_id_list(count);}
1585	;
1586
1587	////////////
1588	// R520-F03, R526-F08
1589	// - form of F08 used with allocatable_decl_list
1590	//
1591	allocatable_stmt
1592	@init {Token lbl = null;}
1593	@after{checkForInclude();}
1594	: (label {lbl=$label.tk;})?
1595	T_ALLOCATABLE ( T_COLON_COLON )? allocatable_decl_list end_of_stmt
1596	{action.allocatable_stmt(lbl, $T_ALLOCATABLE, $end_of_stmt.tk);}
1597	;
1598
1599	////////////
1600	// R527-F08
1601	// - form of F08 used with [ coarray-spec ] option removed
1602	//
1603	allocatable_decl
1604	@init{Token objName=null; boolean hasArraySpec=false; boolean hasCoArraySpec=false;}
1605	: object_name {objName=$object_name.tk;}
1606	( T_LPAREN array_spec T_RPAREN {hasArraySpec=true;} )?
1607	{action.allocatable_decl(objName, hasArraySpec, hasCoArraySpec);}
1608	;
1609
1610	allocatable_decl_list
1611	@init{int count=0;}
1612	: {action.allocatable_decl_list__begin();}
1613	allocatable_decl {count++;} ( T_COMMA allocatable_decl {count++;} )*
1614	{action.allocatable_decl_list(count);}
1615	;
1616
1617	// R521
1618	// generic_name_list substituted for object_name_list
1619	asynchronous_stmt
1620	@init {Token lbl = null;}
1621	@after{checkForInclude();}
1622	: (label {lbl=$label.tk;})? T_ASYNCHRONOUS ( T_COLON_COLON )?
1623	generic_name_list end_of_stmt
1624	{action.asynchronous_stmt(lbl,$T_ASYNCHRONOUS,$end_of_stmt.tk);}
1625	;
1626
1627	// R522
1628	bind_stmt
1629	@init {Token lbl = null;}
1630	@after{checkForInclude();}
1631	: (label {lbl=$label.tk;})? language_binding_spec
1632	( T_COLON_COLON )? bind_entity_list end_of_stmt
1633	{ action.bind_stmt(lbl, $end_of_stmt.tk); }
1634	;
1635
1636	// R523
1637	// T_IDENT inlined for entity_name and common_block_name
1638	bind_entity
1639	: T_IDENT
1640	{ action.bind_entity($T_IDENT, false); }// isCommonBlockName=false
1641	\| T_SLASH T_IDENT T_SLASH
1642	{ action.bind_entity($T_IDENT, true); }// isCommonBlockname=true
1643	;
1644
1645	bind_entity_list
1646	@init{ int count=0;}
1647	: {action.bind_entity_list__begin();}
1648	bind_entity {count++;} ( T_COMMA bind_entity {count++;} )*
1649	{action.bind_entity_list(count);}
1650	;
1651
1652	// R524
1653	data_stmt
1654	@init {Token lbl = null; int count=1;}
1655	@after{checkForInclude();}
1656	: (label {lbl=$label.tk;})? T_DATA data_stmt_set ( ( T_COMMA )?
1657	data_stmt_set {count++;})* end_of_stmt
1658	{ action.data_stmt(lbl, $T_DATA, $end_of_stmt.tk, count); }
1659	;
1660
1661	// R525
1662	data_stmt_set
1663	: data_stmt_object_list
1664	T_SLASH
1665	data_stmt_value_list
1666	T_SLASH
1667	{ action.data_stmt_set(); }
1668	;
1669
1670	// R526
1671	data_stmt_object
1672	@after {
1673	action.data_stmt_object();
1674	}
1675	: variable
1676	\| data_implied_do
1677	;
1678
1679	data_stmt_object_list
1680	@init{ int count=0;}
1681	: {action.data_stmt_object_list__begin();}
1682	data_stmt_object {count++;} ( T_COMMA data_stmt_object {count++;} )*
1683	{action.data_stmt_object_list(count);}
1684	;
1685
1686
1687	// R527
1688	// ERR_CHK 527 scalar_int_expr replaced by expr
1689	// data_i_do_variable replaced by T_IDENT
1690	data_implied_do
1691	@init {
1692	boolean hasThirdExpr = false;
1693	}
1694	: T_LPAREN data_i_do_object_list T_COMMA T_IDENT T_EQUALS
1695	expr T_COMMA expr ( T_COMMA expr { hasThirdExpr = true; })? T_RPAREN
1696	{ action.data_implied_do($T_IDENT, hasThirdExpr); }
1697	;
1698
1699	// R528
1700	// data_ref inlined for scalar_structure_component and array_element
1701	data_i_do_object
1702	@after {
1703	action.data_i_do_object();
1704	}
1705	: data_ref
1706	\| data_implied_do
1707	;
1708
1709	data_i_do_object_list
1710	@init{ int count=0;}
1711	: {action.data_i_do_object_list__begin();}
1712	data_i_do_object {count++;} ( T_COMMA data_i_do_object {count++;} )*
1713	{action.data_i_do_object_list(count);}
1714	;
1715
1716	// R529 data_i_do_variable was scalar_int_variable inlined as T_IDENT
1717	// C556 (R529) The data-i-do-variable shall be a named variable.
1718
1719	// R530
1720	// ERR_CHK R530 designator is scalar-constant or integer constant when
1721	// followed by '*'
1722	// data_stmt_repeat inlined from R531
1723	// structure_constructure covers null_init if 'NULL()' so null_init deleted
1724	// TODO - check for other cases of signed_real_literal_constant and
1725	// real_literal_constant problems
1726	data_stmt_value
1727	options {backtrack=true; k=3;}
1728	@init {Token ast = null;}
1729	@after{action.data_stmt_value(ast);}
1730	: designator (T_ASTERISK data_stmt_constant {ast=$T_ASTERISK;})?
1731	\| int_literal_constant (T_ASTERISK data_stmt_constant {ast=$T_ASTERISK;})?
1732	\| signed_real_literal_constant
1733	\| signed_int_literal_constant
1734	\| complex_literal_constant
1735	\| logical_literal_constant
1736	\| char_literal_constant
1737	\| boz_literal_constant
1738	\| structure_constructor // is null_init if 'NULL()'
1739	\| hollerith_constant // extension??
1740	;
1741
1742	data_stmt_value_list
1743	@init{ int count=0;}
1744	: {action.data_stmt_value_list__begin();}
1745	data_stmt_value {count++;} ( T_COMMA data_stmt_value {count++;} )*
1746	{action.data_stmt_value_list(count);}
1747	;
1748
1749	// R531 data_stmt_repeat inlined as (int_literal_constant \| designator) in R530
1750	// ERRCHK 531 int_constant shall be a scalar_int_constant
1751	// scalar_int_constant replaced by int_constant replaced by
1752	// int_literal_constant as T_IDENT covered by designator
1753	// scalar_int_constant_subobject replaced by designator
1754
1755	scalar_int_constant
1756	: int_constant
1757	{ action.scalar_int_constant(); }
1758	;
1759
1760	hollerith_constant
1761	// : T_DIGIT_STRING T_IDENT
1762	: T_HOLLERITH
1763	{ action.hollerith_constant($T_HOLLERITH); }
1764	;
1765
1766	// R532
1767	// scalar_constant_subobject replaced by designator
1768	// scalar_constant replaced by literal_constant as designator can be T_IDENT
1769	// then literal_constant inlined (except for signed portion)
1770	// structure_constructure covers null_init if 'NULL()' so null_init deleted
1771	// The lookahead in the alternative for signed_real_literal_constant is
1772	// necessary because ANTLR won't look far enough ahead by itself and when it
1773	// sees a T_DIGIT_STRING, it tries the signed_int_literal_constant. this isn't
1774	// correct since the new version of the real_literal_constants can start with
1775	// a T_DIGIT_STRING.
1776	data_stmt_constant
1777	options {backtrack=true; k=3;}
1778	@after {
1779	action.data_stmt_constant();
1780	}
1781	: designator
1782	\| signed_int_literal_constant
1783	\| signed_real_literal_constant
1784	\| complex_literal_constant
1785	\| logical_literal_constant
1786	\| char_literal_constant
1787	\| boz_literal_constant
1788	\| structure_constructor // is null_init if 'NULL()'
1789	;
1790
1791	// R533 int_constant_subobject was constant_subobject inlined as designator
1792	// in R531
1793
1794	// R534 constant_subobject inlined as designator in R533
1795	// C566 (R534) constant-subobject shall be a subobject of a constant.
1796
1797	// R535, R543-F2008
1798	// array_name replaced by T_IDENT
1799	dimension_stmt
1800	@init {Token lbl=null; int count=1;}
1801	@after{checkForInclude();}
1802	: (label {lbl=$label.tk;})? T_DIMENSION ( T_COLON_COLON )?
1803	dimension_decl ( T_COMMA dimension_decl {count++;})* end_of_stmt
1804	{ action.dimension_stmt(lbl, $T_DIMENSION, $end_of_stmt.tk, count); }
1805	;
1806
1807	// R535-subrule
1808	dimension_decl
1809	: T_IDENT T_LPAREN array_spec T_RPAREN
1810	{action.dimension_decl($T_IDENT);}
1811	;
1812
1813	// R536
1814	// generic_name_list substituted for dummy_arg_name_list
1815	intent_stmt
1816	@init {Token lbl = null;}
1817	@after{checkForInclude();}
1818	: (label {lbl=$label.tk;})? T_INTENT T_LPAREN intent_spec T_RPAREN
1819	( T_COLON_COLON )? generic_name_list end_of_stmt
1820	{action.intent_stmt(lbl,$T_INTENT,$end_of_stmt.tk);}
1821	;
1822
1823	// R537
1824	// generic_name_list substituted for dummy_arg_name_list
1825	optional_stmt
1826	@init {Token lbl = null;}
1827	@after{checkForInclude();}
1828	: (label {lbl=$label.tk;})? T_OPTIONAL ( T_COLON_COLON )?
1829	generic_name_list end_of_stmt
1830	{ action.optional_stmt(lbl, $T_OPTIONAL, $end_of_stmt.tk); }
1831
1832	;
1833
1834	// R538
1835	parameter_stmt
1836	@init {Token lbl = null;}
1837	@after{checkForInclude();}
1838	: (label {lbl=$label.tk;})? T_PARAMETER T_LPAREN
1839	named_constant_def_list T_RPAREN end_of_stmt
1840	{action.parameter_stmt(lbl,$T_PARAMETER,$end_of_stmt.tk);}
1841	;
1842
1843	named_constant_def_list
1844	@init{ int count=0;}
1845	: {action.named_constant_def_list__begin();}
1846	named_constant_def {count++;}
1847	( T_COMMA named_constant_def {count++;} )*
1848	{action.named_constant_def_list(count);}
1849	;
1850
1851	// R539
1852	// ERR_CHK 539 initialization_expr replaced by expr
1853	// ERR_CHK 539 named_constant replaced by T_IDENT
1854	named_constant_def
1855	: T_IDENT T_EQUALS expr
1856	{action.named_constant_def($T_IDENT);}
1857	;
1858
1859	// R540
1860	pointer_stmt
1861	@init {Token lbl = null;}
1862	@after{checkForInclude();}
1863	: (label {lbl=$label.tk;})? T_POINTER ( T_COLON_COLON )?
1864	pointer_decl_list end_of_stmt
1865	{action.pointer_stmt(lbl,$T_POINTER,$end_of_stmt.tk);}
1866	;
1867
1868	pointer_decl_list
1869	@init{ int count=0;}
1870	: {action.pointer_decl_list__begin();}
1871	pointer_decl {count++;} ( T_COMMA pointer_decl {count++;} )*
1872	{action.pointer_decl_list(count);}
1873	;
1874
1875	// R541
1876	// T_IDENT inlined as object_name and proc_entity_name (removing second alt)
1877	pointer_decl
1878	@init{boolean hasSpecList=false;}
1879	: T_IDENT ( T_LPAREN deferred_shape_spec_list T_RPAREN
1880	{hasSpecList=true;})?
1881	{action.pointer_decl($T_IDENT,hasSpecList);}
1882	;
1883
1884	// R542
1885	// generic_name_list substituted for entity_name_list
1886	protected_stmt
1887	@init {Token lbl = null;}
1888	@after{checkForInclude();}
1889	: (label {lbl=$label.tk;})? T_PROTECTED ( T_COLON_COLON )?
1890	generic_name_list end_of_stmt
1891	{action.protected_stmt(lbl,$T_PROTECTED,$end_of_stmt.tk);}
1892	;
1893
1894	// R543
1895	save_stmt
1896	@init {Token lbl = null; boolean hasSavedEntityList=false;}
1897	@after{checkForInclude();}
1898	: (label {lbl=$label.tk;})? T_SAVE ( ( T_COLON_COLON )?
1899	saved_entity_list {hasSavedEntityList=true;})? end_of_stmt
1900	{action.save_stmt(lbl,$T_SAVE,$end_of_stmt.tk,hasSavedEntityList);}
1901	;
1902
1903	// R544
1904	// T_IDENT inlined for object_name, proc_pointer_name (removing second alt),
1905	// and common_block_name
1906	saved_entity
1907	: id=T_IDENT
1908	{action.saved_entity(id, false);}
1909	\| T_SLASH id=T_IDENT T_SLASH
1910	{action.saved_entity(id, true);} // is common block name
1911	;
1912
1913	saved_entity_list
1914	@init{ int count=0;}
1915	: {action.saved_entity_list__begin();}
1916	saved_entity {count++;} ( T_COMMA saved_entity {count++;} )*
1917	{action.saved_entity_list(count);}
1918	;
1919
1920
1921	// R545 proc_pointer_name was name inlined as T_IDENT
1922
1923	// R546, R555-F08
1924	// T_IDENT inlined for object_name
1925	target_stmt
1926	@init {Token lbl = null;int count=1;}
1927	@after{checkForInclude();}
1928	: (label {lbl=$label.tk;})?
1929	T_TARGET ( T_COLON_COLON )? target_decl_list end_of_stmt
1930	{action.target_stmt(lbl,$T_TARGET,$end_of_stmt.tk);}
1931	;
1932
1933	// R557-F08
1934	target_decl
1935	@init{boolean hasArraySpec=false; boolean hasCoarraySpec=false;}
1936	: T_IDENT ( T_LPAREN array_spec T_RPAREN {hasArraySpec=true;} )?
1937	{action.target_decl($T_IDENT,hasArraySpec,hasCoarraySpec);}
1938	;
1939
1940	// R557-F08
1941	target_decl_list
1942	@init{ int count=0;}
1943	: {action.target_decl_list__begin();}
1944	target_decl {count++;} ( T_COMMA target_decl {count++;} )*
1945	{action.target_decl_list(count);}
1946	;
1947
1948	// R547
1949	// generic_name_list substituted for dummy_arg_name_list
1950	value_stmt
1951	@init {Token lbl = null;}
1952	@after{checkForInclude();}
1953	: (label {lbl=$label.tk;})? T_VALUE ( T_COLON_COLON )?
1954	generic_name_list end_of_stmt
1955	{action.value_stmt(lbl,$T_VALUE,$end_of_stmt.tk);}
1956	;
1957
1958	// R548
1959	// generic_name_list substituted for object_name_list
1960	volatile_stmt
1961	@init {Token lbl = null;}
1962	@after{checkForInclude();}
1963	: (label {lbl=$label.tk;})? T_VOLATILE ( T_COLON_COLON )?
1964	generic_name_list end_of_stmt
1965	{action.volatile_stmt(lbl,$T_VOLATILE,$end_of_stmt.tk);}
1966	;
1967
1968	// R549
1969	implicit_stmt
1970	@init {Token lbl = null;}
1971	@after{checkForInclude();}
1972	: (label {lbl=$label.tk;})? T_IMPLICIT implicit_spec_list end_of_stmt
1973	{action.implicit_stmt(lbl, $T_IMPLICIT, null, $end_of_stmt.tk,
1974	true);} // hasImplicitSpecList=true
1975	\| (label {lbl=$label.tk;})? T_IMPLICIT T_NONE end_of_stmt
1976	{action.implicit_stmt(lbl, $T_IMPLICIT, $T_NONE, $end_of_stmt.tk,
1977	false);} // hasImplicitSpecList=false
1978	;
1979
1980	// R550
1981	implicit_spec
1982	: declaration_type_spec T_LPAREN letter_spec_list T_RPAREN
1983	{ action.implicit_spec(); }
1984	;
1985
1986	implicit_spec_list
1987	@init{ int count=0;}
1988	: {action.implicit_spec_list__begin();}
1989	implicit_spec {count++;} ( T_COMMA implicit_spec {count++;} )*
1990	{action.implicit_spec_list(count);}
1991	;
1992
1993
1994	// R551
1995	// TODO: here, we'll accept a T_IDENT, and then we'll have to do error
1996	// checking on it.
1997	letter_spec
1998	: id1=T_IDENT ( T_MINUS id2=T_IDENT )?
1999	{ action.letter_spec(id1, id2); }
2000	;
2001
2002	letter_spec_list
2003	@init{ int count=0;}
2004	: {action.letter_spec_list__begin();}
2005	letter_spec {count++;} ( T_COMMA letter_spec {count++;} )*
2006	{action.letter_spec_list(count);}
2007	;
2008
2009	// R552
2010	// T_IDENT inlined for namelist_group_name
2011	namelist_stmt
2012	@init {Token lbl = null;int count =1;}
2013	@after{checkForInclude();}
2014	: (label {lbl=$label.tk;})? T_NAMELIST T_SLASH nlName=T_IDENT T_SLASH
2015	{action.namelist_group_name(nlName);}
2016	namelist_group_object_list
2017	( ( T_COMMA )? T_SLASH nlName=T_IDENT T_SLASH
2018	{action.namelist_group_name(nlName);}
2019	namelist_group_object_list {count++;})* end_of_stmt
2020	{action.namelist_stmt(lbl,$T_NAMELIST,$end_of_stmt.tk,count);}
2021	;
2022
2023	// R553 namelist_group_object was variable_name inlined as T_IDENT
2024
2025	// T_IDENT inlined for namelist_group_object
2026	namelist_group_object_list
2027	@init{ int count=0;}
2028	: {action.namelist_group_object_list__begin();}
2029	goName=T_IDENT {action.namelist_group_object(goName); count++;}
2030	( T_COMMA goName=T_IDENT
2031	{action.namelist_group_object(goName); count++;} )*
2032	{action.namelist_group_object_list(count);}
2033	;
2034
2035	// R554
2036	equivalence_stmt
2037	@init {Token lbl = null;}
2038	@after{checkForInclude();}
2039	: (label {lbl=$label.tk;})? T_EQUIVALENCE equivalence_set_list
2040	end_of_stmt
2041	{action.equivalence_stmt(lbl, $T_EQUIVALENCE, $end_of_stmt.tk);}
2042	;
2043
2044	// R555
2045	equivalence_set
2046	: T_LPAREN equivalence_object T_COMMA equivalence_object_list T_RPAREN
2047	{ action.equivalence_set(); }
2048	;
2049
2050
2051	equivalence_set_list
2052	@init{ int count=0;}
2053	: {action.equivalence_set_list__begin();}
2054	equivalence_set {count++;} ( T_COMMA equivalence_set {count++;} )*
2055	{action.equivalence_set_list(count);}
2056	;
2057
2058	// R556
2059	// T_IDENT inlined for variable_name
2060	// data_ref inlined for array_element
2061	// data_ref isa T_IDENT so T_IDENT deleted (removing first alt)
2062	// substring isa data_ref so data_ref deleted (removing second alt)
2063	equivalence_object
2064	: substring { action.equivalence_object(); }
2065	;
2066
2067	equivalence_object_list
2068	@init{ int count=0;}
2069	: {action.equivalence_object_list__begin();}
2070	equivalence_object {count++;}
2071	( T_COMMA equivalence_object {count++;} )*
2072	{action.equivalence_object_list(count);}
2073	;
2074
2075	// R557
2076	// action.common_block_name must be called here because it needs
2077	// to be called even if optional '/common_block_name/' is not present
2078	common_stmt
2079	@init {Token lbl=null; int numBlocks=1;}
2080	@after{checkForInclude();}
2081	: (label {lbl=$label.tk;})?
2082	T_COMMON ( cb_name=common_block_name )?
2083	{ action.common_block_name(cb_name); }
2084	common_block_object_list
2085	( ( T_COMMA )? cb_name=common_block_name
2086	{ action.common_block_name(cb_name); }
2087	common_block_object_list {numBlocks++;} )* end_of_stmt
2088	{action.common_stmt(lbl, $T_COMMON, $end_of_stmt.tk, numBlocks);}
2089	;
2090
2091	// T_SLASH_SLASH must be a option in case there are no spaces slashes, '//'
2092	common_block_name returns [Token id]
2093	: T_SLASH_SLASH {id=null;}
2094	\| T_SLASH (T_IDENT)? T_SLASH {id=$T_IDENT;}
2095	;
2096
2097	// R558
2098	// T_IDENT inlined for variable_name and proc_pointer_name
2099	// T_IDENT covered by first alt so second deleted
2100	common_block_object
2101	@init{boolean hasShapeSpecList=false;}
2102	: T_IDENT ( T_LPAREN explicit_shape_spec_list T_RPAREN
2103	{hasShapeSpecList=true;})?
2104	{action.common_block_object($T_IDENT,hasShapeSpecList);}
2105	;
2106
2107	common_block_object_list
2108	@init{ int count=0;}
2109	: {action.common_block_object_list__begin();}
2110	common_block_object {count++;}
2111	( T_COMMA common_block_object {count++;} )*
2112	{action.common_block_object_list(count);}
2113	;
2114
2115	/*
2116	Section 6:
2117	*/
2118
2119	// R601
2120	variable
2121	: designator {action.variable();}
2122	;
2123
2124	// R602 variable_name was name inlined as T_IDENT
2125
2126	// R603
2127	// : object-name // T_IDENT (data-ref isa T_IDENT)
2128	// \| array-element // R616 is data-ref
2129	// \| array-section // R617 is data-ref [ (substring-range) ]
2130	// \| structure-component // R614 is data-ref
2131	// \| substring
2132	// (substring-range) may be matched in data-ref
2133	// this rule is now identical to substring
2134	designator
2135	@init{boolean hasSubstringRange = false;}
2136	: data_ref (T_LPAREN substring_range {hasSubstringRange=true;} T_RPAREN)?
2137	{ action.designator(hasSubstringRange); }
2138	\| char_literal_constant T_LPAREN substring_range T_RPAREN
2139	{ hasSubstringRange=true; action.substring(hasSubstringRange); }
2140	;
2141
2142	//
2143	// a function_reference is ambiguous with designator, ie, foo(b) could be an
2144	// array element
2145	// function_reference : procedure_designator T_LPAREN
2146	// ( actual_arg_spec_list )? T_RPAREN
2147	// procedure_designator isa data_ref
2148	// C1220 (R1217) The procedure-designator shall designate a function.
2149	// data_ref may (or not) match T_LPAREN ( actual_arg_spec_list )? T_RPAREN,
2150	// so is optional
2151	designator_or_func_ref
2152	@init {
2153	boolean hasSubstringRangeOrArgList = false;
2154	boolean hasSubstringRange = false;
2155	}
2156	@after {
2157	action.designator_or_func_ref();
2158	}
2159	: data_ref (T_LPAREN substring_range_or_arg_list
2160	{
2161	hasSubstringRangeOrArgList = true;
2162	hasSubstringRange=
2163	$substring_range_or_arg_list.isSubstringRange;
2164	}
2165	T_RPAREN)?
2166	{
2167	if (hasSubstringRangeOrArgList) {
2168	if (hasSubstringRange) {
2169	action.designator(hasSubstringRange);
2170	} else {
2171	// hasActualArgSpecList=true
2172	action.function_reference(true);
2173	}
2174	}
2175	}
2176	\| char_literal_constant T_LPAREN substring_range T_RPAREN
2177	{ hasSubstringRange=true; action.substring(hasSubstringRange); }
2178	;
2179
2180	substring_range_or_arg_list returns [boolean isSubstringRange]
2181	@init {
2182	boolean hasUpperBound = false;
2183	Token keyword = null;
2184	int count = 0;
2185	}
2186	@after {
2187	action.substring_range_or_arg_list();
2188	}
2189	: T_COLON (expr {hasUpperBound = true;})? // substring_range
2190	{
2191	// hasLowerBound=false
2192	action.substring_range(false, hasUpperBound);
2193	isSubstringRange=true;
2194	}
2195	\| {
2196	/* mimic actual-arg-spec-list */
2197	action.actual_arg_spec_list__begin();
2198	}
2199	expr substr_range_or_arg_list_suffix
2200	{
2201	isSubstringRange =
2202	$substr_range_or_arg_list_suffix.isSubstringRange;
2203	}
2204	\| {
2205	/* mimic actual-arg-spec-list */
2206	action.actual_arg_spec_list__begin();
2207	}
2208	T_IDENT T_EQUALS expr
2209	{
2210	count++;
2211	action.actual_arg(true, null);
2212	action.actual_arg_spec($T_IDENT);
2213	}
2214	( T_COMMA actual_arg_spec {count++;} )*
2215	{
2216	action.actual_arg_spec_list(count);
2217	isSubstringRange = false;
2218	}
2219	\| {
2220	/* mimic actual-arg-spec-list */
2221	action.actual_arg_spec_list__begin();
2222	}
2223	( T_IDENT T_EQUALS {keyword=$T_IDENT;} )? T_ASTERISK label
2224	{
2225	count++;
2226	action.actual_arg(false, $label.tk);
2227	action.actual_arg_spec(keyword);
2228	}
2229	( T_COMMA actual_arg_spec {count++;} )*
2230	{
2231	action.actual_arg_spec_list(count);
2232	isSubstringRange = false;
2233	}
2234	;
2235
2236	substr_range_or_arg_list_suffix returns [boolean isSubstringRange]
2237	@init{boolean hasUpperBound = false; int count = 0;}
2238	@after {
2239	action.substr_range_or_arg_list_suffix();
2240	}
2241	: {
2242	// guessed wrong on list creation, inform of error
2243	action.actual_arg_spec_list(-1);
2244	}
2245	T_COLON (expr {hasUpperBound=true;})? // substring_range
2246	{
2247	// hasLowerBound=true
2248	action.substring_range(true, hasUpperBound);
2249	isSubstringRange = true;
2250	}
2251	\|
2252	{
2253	count++;
2254	action.actual_arg(true, null); // hasExpr=true, label=null
2255	action.actual_arg_spec(null); // keywork=null
2256	}
2257	( T_COMMA actual_arg_spec {count++;} )*
2258	{
2259	action.actual_arg_spec_list(count);
2260	isSubstringRange=false;
2261	} // actual_arg_spec_list
2262	;
2263
2264	// R604
2265	logical_variable
2266	: variable
2267	{ action.logical_variable(); }
2268	;
2269
2270	// R605
2271	default_logical_variable
2272	: variable
2273	{ action.default_logical_variable(); }
2274	;
2275
2276	scalar_default_logical_variable
2277	: variable
2278	{ action.scalar_default_logical_variable(); }
2279	;
2280
2281	// R606
2282	char_variable
2283	: variable
2284	{ action.char_variable(); }
2285	;
2286
2287	// R607
2288	default_char_variable
2289	: variable
2290	{ action.default_char_variable(); }
2291	;
2292
2293	scalar_default_char_variable
2294	: variable
2295	{ action.scalar_default_char_variable(); }
2296	;
2297
2298	// R608
2299	int_variable
2300	: variable
2301	{ action.int_variable(); }
2302	;
2303
2304	// R609
2305	// C608 (R610) parent_string shall be of type character
2306	// fix for ambiguity in data_ref allows it to match T_LPAREN substring_range
2307	// T_RPAREN, so required T_LPAREN substring_range T_RPAREN made optional
2308	// ERR_CHK 609 ensure final () is (substring-range)
2309	substring
2310	@init{boolean hasSubstringRange = false;}
2311	: data_ref (T_LPAREN substring_range {hasSubstringRange=true;} T_RPAREN)?
2312	{ action.substring(hasSubstringRange); }
2313	\| char_literal_constant T_LPAREN substring_range T_RPAREN
2314	{ action.substring(true); }
2315	;
2316
2317	// R610 parent_string inlined in R609 as (data_ref \| char_literal_constant)
2318	// T_IDENT inlined for scalar_variable_name
2319	// data_ref inlined for scalar_structure_component and array_element
2320	// data_ref isa T_IDENT so T_IDENT deleted
2321	// scalar_constant replaced by char_literal_constant as data_ref isa T_IDENT
2322	// and must be character
2323
2324	// R611
2325	// ERR_CHK 611 scalar_int_expr replaced by expr
2326	substring_range
2327	@init{
2328	boolean hasLowerBound = false;
2329	boolean hasUpperBound = false;
2330	}
2331	: (expr {hasLowerBound = true;})? T_COLON (expr {hasUpperBound = true;})?
2332	{ action.substring_range(hasLowerBound, hasUpperBound); }
2333	;
2334
2335	// R612
2336	data_ref
2337	@init{int numPartRefs = 0;}
2338	: part_ref {numPartRefs += 1;} ( T_PERCENT part_ref {numPartRefs += 1;})*
2339	{action.data_ref(numPartRefs);}
2340	;
2341
2342	// R613
2343	// T_IDENT inlined for part_name
2344	// with k=2, this path is chosen over T_LPAREN substring_range T_RPAREN
2345	// TODO error: if a function call, should match id rather than
2346	// (section_subscript_list)
2347	// a = foo(b) is ambiguous YUK...
2348	part_ref
2349	options {k=2;}
2350	@init{boolean hasSSL = false;
2351	boolean hasImageSelector = false;
2352	}
2353	: (T_IDENT T_LPAREN) => T_IDENT T_LPAREN section_subscript_list T_RPAREN
2354	{hasSSL=true; action.part_ref($T_IDENT, hasSSL, hasImageSelector);}
2355	\| T_IDENT
2356	{action.part_ref($T_IDENT, hasSSL, hasImageSelector);}
2357	;
2358
2359	// R614 structure_component inlined as data_ref
2360
2361	// R615 type_param_inquiry inlined in R701 then deleted as can be designator
2362	// T_IDENT inlined for type_param_name
2363
2364	// R616 array_element inlined as data_ref
2365
2366	// R617 array_section inlined in R603
2367
2368	// R618 subscript inlined as expr
2369	// ERR_CHK 618 scalar_int_expr replaced by expr
2370
2371	// R619
2372	// expr inlined for subscript, vector_subscript, and stride (thus deleted
2373	// option 3)
2374	// refactored first optional expr from subscript_triplet
2375	// modified to also match actual_arg_spec_list to reduce ambiguities and
2376	// need for backtracking
2377	section_subscript returns [boolean isEmpty]
2378	@init {
2379	boolean hasLowerBounds = false;
2380	boolean hasUpperBounds = false;
2381	boolean hasStride = false;
2382	boolean hasExpr = false;
2383	}
2384	: expr section_subscript_ambiguous
2385	\| T_COLON (expr {hasUpperBounds=true;})?
2386	(T_COLON expr {hasStride=true;})?
2387	{ action.section_subscript(hasLowerBounds, hasUpperBounds,
2388	hasStride, false); }
2389	\| T_COLON_COLON expr
2390	{hasStride=true; action.section_subscript(hasLowerBounds,
2391	hasUpperBounds, hasStride, false);}
2392	\| T_IDENT T_EQUALS expr // could be an actual-arg, see R1220
2393	{ hasExpr=true; action.actual_arg(hasExpr, null);
2394	action.actual_arg_spec($T_IDENT); }
2395	\| T_IDENT T_EQUALS T_ASTERISK label // could be an actual-arg, see R1220
2396	{ action.actual_arg(hasExpr, $label.tk);
2397	action.actual_arg_spec($T_IDENT); }
2398	\| T_ASTERISK label /* could be an actual-arg, see R1220 */
2399	{ action.actual_arg(hasExpr, $label.tk);
2400	action.actual_arg_spec(null); }
2401	\| { isEmpty = true; /* empty could be an actual-arg, see R1220 */ }
2402	;
2403
2404	section_subscript_ambiguous
2405	@init {
2406	boolean hasLowerBound = true;
2407	boolean hasUpperBound = false;
2408	boolean hasStride = false;
2409	boolean isAmbiguous = false;
2410	}
2411	: T_COLON (expr {hasUpperBound=true;})? (T_COLON expr {hasStride=true;})?
2412	{ action.section_subscript(hasLowerBound, hasUpperBound,
2413	hasStride, isAmbiguous);}
2414	// this alternative is necessary because if alt1 above has no expr
2415	// following the first : and there is the optional second : with no
2416	// WS between the two, the lexer will make a T_COLON_COLON token
2417	// instead of two T_COLON tokens. in this case, the second expr is
2418	// required. for an example, see J3/04-007, Note 7.44.
2419	\| T_COLON_COLON expr
2420	{ hasStride=true;
2421	action.section_subscript(hasLowerBound, hasUpperBound,
2422	hasStride, isAmbiguous);}
2423	\| { /* empty, could be an actual-arg, see R1220 */
2424	isAmbiguous=true;
2425	action.section_subscript(hasLowerBound, hasUpperBound,
2426	hasStride, isAmbiguous);
2427	}
2428	;
2429
2430	section_subscript_list
2431	@init{int count = 0;}
2432	: { action.section_subscript_list__begin(); }
2433	isEmpty=section_subscript
2434	{
2435	if (isEmpty == false) count += 1;
2436	}
2437	(T_COMMA section_subscript {count += 1;})*
2438	{ action.section_subscript_list(count); }
2439	;
2440
2441	// R620 subscript_triplet inlined in R619
2442	// inlined expr as subscript and stride in subscript_triplet
2443
2444	// R621 stride inlined as expr
2445	// ERR_CHK 621 scalar_int_expr replaced by expr
2446
2447	// R622
2448	// ERR_CHK 622 int_expr replaced by expr
2449	vector_subscript
2450	: expr
2451	{ action.vector_subscript(); }
2452	;
2453
2454	// R622 inlined vector_subscript as expr in R619
2455	// ERR_CHK 622 int_expr replaced by expr
2456
2457	// R623
2458	// modified to remove backtracking by looking for the token inserted during
2459	// the lexical prepass if a :: was found (which required alt1 below).
2460	allocate_stmt
2461	@init {Token lbl = null;
2462	boolean hasTypeSpec = false;
2463	boolean hasAllocOptList = false;}
2464	@after{checkForInclude();}
2465	: (label {lbl=$label.tk;})? T_ALLOCATE_STMT_1 T_ALLOCATE T_LPAREN
2466	type_spec T_COLON_COLON
2467	allocation_list
2468	( T_COMMA alloc_opt_list {hasAllocOptList=true;} )? T_RPAREN
2469	end_of_stmt
2470	{
2471	hasTypeSpec = true;
2472	action.allocate_stmt(lbl, $T_ALLOCATE, $end_of_stmt.tk,
2473	hasTypeSpec, hasAllocOptList);
2474	}
2475	\| (label {lbl=$label.tk;})? T_ALLOCATE T_LPAREN
2476	allocation_list
2477	( T_COMMA alloc_opt_list {hasAllocOptList=true;} )? T_RPAREN
2478	end_of_stmt
2479	{
2480	action.allocate_stmt(lbl, $T_ALLOCATE, $end_of_stmt.tk,
2481	hasTypeSpec, hasAllocOptList);
2482	}
2483	;
2484
2485	// R624
2486	// ERR_CHK 624 source_expr replaced by expr
2487	// stat_variable and errmsg_variable replaced by designator
2488	alloc_opt
2489	: T_IDENT T_EQUALS expr
2490	/* {'STAT','ERRMSG'} are variables {SOURCE'} is expr */
2491	{ action.alloc_opt($T_IDENT); }
2492	;
2493
2494	alloc_opt_list
2495	@init{ int count=0;}
2496	: {action.alloc_opt_list__begin();}
2497	alloc_opt {count++;} ( T_COMMA alloc_opt {count++;} )*
2498	{action.alloc_opt_list(count);}
2499	;
2500
2501	// R625 stat_variable was scalar_int_variable inlined in R624 and R636
2502	// R626 errmsg_variable was scalar_default_char_variable inlined in R624
2503	// and R636
2504	// R627 inlined source_expr was expr
2505
2506	////////////
2507	// R628-F03, R631-F08
2508	// - F08 specific syntax removed
2509	//
2510	allocation
2511	@init{boolean hasAllocateShapeSpecList = false; boolean hasAllocateCoarraySpec = false;}
2512	: allocate_object
2513	( T_LPAREN allocate_shape_spec_list {hasAllocateShapeSpecList=true;} T_RPAREN )?
2514	{action.allocation(hasAllocateShapeSpecList, hasAllocateCoarraySpec);}
2515	;
2516
2517	allocation_list
2518	@init{ int count=0;}
2519	: {action.allocation_list__begin();}
2520	allocation {count++;} ( T_COMMA allocation {count++;} )*
2521	{action.allocation_list(count);}
2522	;
2523
2524	// R629
2525	// T_IDENT inlined for variable_name
2526	// data_ref inlined for structure_component
2527	// data_ref isa T_IDENT so T_IDENT deleted
2528	allocate_object
2529	: data_ref
2530	{ action.allocate_object(); }
2531	;
2532
2533	allocate_object_list
2534	@init{ int count=0;}
2535	: {action.allocate_object_list__begin();}
2536	allocate_object {count++;} ( T_COMMA allocate_object {count++;} )*
2537	{action.allocate_object_list(count);}
2538	;
2539
2540	// R630
2541	// ERR_CHK 630a lower_bound_expr replaced by expr
2542	// ERR_CHK 630b upper_bound_expr replaced by expr
2543	allocate_shape_spec
2544	@init{boolean hasLowerBound = false; boolean hasUpperBound = true;}
2545	: expr (T_COLON expr)?
2546	{ // note, allocate-shape-spec always has upper bound
2547	// grammar was refactored to remove left recursion,
2548	// looks deceptive
2549	action.allocate_shape_spec(hasLowerBound, hasUpperBound);
2550	}
2551	;
2552
2553	allocate_shape_spec_list
2554	@init{ int count=0;}
2555	: {action.allocate_shape_spec_list__begin();}
2556	allocate_shape_spec {count++;}
2557	( T_COMMA allocate_shape_spec {count++;} )*
2558	{action.allocate_shape_spec_list(count);}
2559	;
2560
2561	// R631 inlined lower_bound_expr was scalar_int_expr
2562
2563	// R632 inlined upper_bound_expr was scalar_int_expr
2564
2565	// R633
2566	nullify_stmt
2567	@init {Token lbl = null;} // @init{INIT_TOKEN_NULL(lbl);}
2568	@after{checkForInclude();}
2569	: (label {lbl=$label.tk;})?
2570	T_NULLIFY T_LPAREN pointer_object_list T_RPAREN end_of_stmt
2571	{ action.nullify_stmt(lbl, $T_NULLIFY, $end_of_stmt.tk); }
2572	;
2573
2574	// R634
2575	// T_IDENT inlined for variable_name and proc_pointer_name
2576	// data_ref inlined for structure_component
2577	// data_ref can be a T_IDENT so T_IDENT deleted
2578	pointer_object
2579	: data_ref
2580	{ action.pointer_object(); }
2581	;
2582
2583	pointer_object_list
2584	@init{ int count=0;}
2585	: {action.pointer_object_list__begin();}
2586	pointer_object {count++;} ( T_COMMA pointer_object {count++;} )*
2587	{action.pointer_object_list(count);}
2588	;
2589
2590	// R635
2591	deallocate_stmt
2592	@init {Token lbl = null; boolean hasDeallocOptList=false;}
2593	@after{checkForInclude();}
2594	: (label {lbl=$label.tk;})? T_DEALLOCATE T_LPAREN allocate_object_list
2595	( T_COMMA dealloc_opt_list {hasDeallocOptList=true;})?
2596	T_RPAREN end_of_stmt
2597	{action.deallocate_stmt(lbl, $T_DEALLOCATE, $end_of_stmt.tk,
2598	hasDeallocOptList);}
2599	;
2600
2601	// R636
2602	// stat_variable and errmsg_variable replaced by designator
2603	dealloc_opt
2604	: T_IDENT /* {'STAT','ERRMSG'} */ T_EQUALS designator
2605	{ action.dealloc_opt($T_IDENT); }
2606	;
2607
2608	dealloc_opt_list
2609	@init{ int count=0;}
2610	: {action.dealloc_opt_list__begin();}
2611	dealloc_opt {count++;} ( T_COMMA dealloc_opt {count++;} )*
2612	{action.dealloc_opt_list(count);}
2613	;
2614
2615	/*
2616	* Section 7:
2617	*/
2618
2619	// R701
2620	// constant replaced by literal_constant as T_IDENT can be designator
2621	// T_IDENT inlined for type_param_name
2622	// data_ref in designator can be a T_IDENT so T_IDENT deleted
2623	// type_param_inquiry is designator T_PERCENT T_IDENT can be designator so
2624	// deleted
2625	// function_reference integrated with designator (was ambiguous) and
2626	// deleted (to reduce backtracking)
2627	primary
2628	options {backtrack=true;} // alt 1,4 ambiguous
2629	@after {
2630	action.primary();
2631	}
2632	: designator_or_func_ref
2633	\| literal_constant
2634	\| array_constructor
2635	\| structure_constructor
2636	\| T_LPAREN expr T_RPAREN
2637	;
2638
2639	// R702
2640	level_1_expr
2641	@init{Token tk = null;} //@init{INIT_TOKEN_NULL(tk);}
2642	: (defined_unary_op {tk = $defined_unary_op.tk;})? primary
2643	{action.level_1_expr(tk);}
2644	;
2645
2646	// R703
2647	defined_unary_op returns [Token tk]
2648	: T_DEFINED_OP {tk = $T_DEFINED_OP;}
2649	{ action.defined_unary_op($T_DEFINED_OP); }
2650	;
2651
2652	// inserted as R704 functionality
2653	power_operand
2654	@init{boolean hasPowerOperand = false;}
2655	: level_1_expr (power_op power_operand {hasPowerOperand = true;})?
2656	{action.power_operand(hasPowerOperand);}
2657	;
2658
2659	// R704
2660	// see power_operand
2661	mult_operand
2662	@init{int numMultOps = 0;}
2663	// : level_1_expr ( power_op mult_operand )?
2664	// : power_operand
2665	: power_operand (mult_op power_operand
2666	{ action.mult_operand__mult_op($mult_op.tk); numMultOps += 1; })*
2667	{ action.mult_operand(numMultOps); }
2668	;
2669
2670	// R705
2671	// moved leading optionals to mult_operand
2672	add_operand
2673	@init{int numAddOps = 0;}
2674	// : ( add_operand mult_op )? mult_operand
2675	// : ( mult_operand mult_op )* mult_operand
2676	: (tk=add_op)? mult_operand
2677	( tk1=add_op mult_operand
2678	{action.add_operand__add_op(tk1); numAddOps += 1;}
2679	)*
2680	{action.add_operand(tk, numAddOps);}
2681	;
2682
2683	// R706
2684	// moved leading optionals to add_operand
2685	level_2_expr
2686	@init{int numConcatOps = 0;}
2687	// : ( ( level_2_expr )? add_op )? add_operand
2688	// check notes on how to remove this left recursion
2689	// (WARNING something like the following)
2690	// : (add_op)? ( add_operand add_op )* add_operand
2691	: add_operand ( concat_op add_operand {numConcatOps += 1;})*
2692	{action.level_2_expr(numConcatOps);}
2693	;
2694
2695	// R707
2696	power_op returns [Token tk]
2697	: T_POWER {tk = $T_POWER;}
2698	{ action.power_op($T_POWER); }
2699	;
2700
2701	// R708
2702	mult_op returns [Token tk]
2703	: T_ASTERISK { tk = $T_ASTERISK; action.mult_op(tk); }
2704	\| T_SLASH { tk = $T_SLASH; action.mult_op(tk); }
2705	;
2706
2707	// R709
2708	add_op returns [Token tk]
2709	: T_PLUS { tk = $T_PLUS; action.add_op(tk); }
2710	\| T_MINUS { tk = $T_MINUS; action.add_op(tk); }
2711	;
2712
2713	// R710
2714	// moved leading optional to level_2_expr
2715	level_3_expr
2716	@init{Token relOp = null;} //@init{INIT_TOKEN_NULL(relOp);}
2717	// : ( level_3_expr concat_op )? level_2_expr
2718	// : ( level_2_expr concat_op )* level_2_expr
2719	: level_2_expr (rel_op level_2_expr {relOp = $rel_op.tk;})?
2720	{action.level_3_expr(relOp);}
2721	;
2722
2723	// R711
2724	concat_op returns [Token tk]
2725	: T_SLASH_SLASH { tk = $T_SLASH_SLASH; action.concat_op(tk); }
2726	;
2727
2728	// R712
2729	// moved leading optional to level_3_expr
2730	// inlined level_3_expr for level_4_expr in R714
2731	//level_4_expr
2732	// : ( level_3_expr rel_op )? level_3_expr
2733	// : level_3_expr
2734	// ;
2735
2736	// R713
2737	rel_op returns [Token tk]
2738	@after {
2739	action.rel_op(tk);
2740	}
2741	: T_EQ {tk=$T_EQ;}
2742	\| T_NE {tk=$T_NE;}
2743	\| T_LT {tk=$T_LT;}
2744	\| T_LE {tk=$T_LE;}
2745	\| T_GT {tk=$T_GT;}
2746	\| T_GE {tk=$T_GE;}
2747	\| T_EQ_EQ {tk=$T_EQ_EQ;}
2748	\| T_SLASH_EQ {tk=$T_SLASH_EQ;}
2749	\| T_LESSTHAN {tk=$T_LESSTHAN;}
2750	\| T_LESSTHAN_EQ {tk=$T_LESSTHAN_EQ;}
2751	\| T_GREATERTHAN {tk=$T_GREATERTHAN;}
2752	\| T_GREATERTHAN_EQ {tk=$T_GREATERTHAN_EQ;}
2753	;
2754
2755	// R714
2756	// level_4_expr inlined as level_3_expr
2757	and_operand
2758	@init {
2759	boolean hasNotOp0 = false; // @init{INIT_BOOL_FALSE(hasNotOp0);
2760	boolean hasNotOp1 = false; // @init{INIT_BOOL_FALSE(hasNotOp1);
2761	int numAndOps = 0;
2762	}
2763	// : ( not_op )? level_3_expr
2764	: (not_op {hasNotOp0=true;})?
2765	level_3_expr
2766	(and_op {hasNotOp1=false;} (not_op {hasNotOp1=true;})? level_3_expr
2767	{action.and_operand__not_op(hasNotOp1); numAndOps += 1;}
2768	)*
2769	{action.and_operand(hasNotOp0, numAndOps);}
2770	;
2771
2772	// R715
2773	// moved leading optional to or_operand
2774	or_operand
2775	@init{int numOrOps = 0;}
2776	// : ( or_operand and_op )? and_operand
2777	// : ( and_operand and_op )* and_operand
2778	: and_operand (or_op and_operand {numOrOps += 1;})*
2779	{ action.or_operand(numOrOps); }
2780	;
2781
2782	// R716
2783	// moved leading optional to or_operand
2784	// TODO - action for equiv_op token
2785	equiv_operand
2786	@init{int numEquivOps = 0;}
2787	// : ( equiv_operand or_op )? or_operand
2788	// : ( or_operand or_op )* or_operand
2789	: or_operand
2790	(equiv_op or_operand
2791	{action.equiv_operand__equiv_op($equiv_op.tk); numEquivOps += 1;}
2792	)*
2793	{action.equiv_operand(numEquivOps);}
2794	;
2795
2796	// R717
2797	// moved leading optional to equiv_operand
2798	level_5_expr
2799	@init{int numDefinedBinaryOps = 0;}
2800	// : ( level_5_expr equiv_op )? equiv_operand
2801	// : ( equiv_operand equiv_op )* equiv_operand
2802	: equiv_operand (defined_binary_op equiv_operand
2803	{action.level_5_expr__defined_binary_op($defined_binary_op.tk);
2804	numDefinedBinaryOps += 1;} )*
2805	{action.level_5_expr(numDefinedBinaryOps);}
2806	;
2807
2808	// R718
2809	not_op returns [Token tk]
2810	: T_NOT { tk = $T_NOT; action.not_op(tk); }
2811	;
2812
2813	// R719
2814	and_op returns [Token tk]
2815	: T_AND { tk = $T_AND; action.and_op(tk); }
2816	;
2817
2818	// R720
2819	or_op returns [Token tk]
2820	: T_OR { tk = $T_OR; action.or_op(tk); }
2821	;
2822
2823	// R721
2824	equiv_op returns [Token tk]
2825	: T_EQV { tk = $T_EQV; action.equiv_op(tk); }
2826	\| T_NEQV { tk = $T_NEQV; action.equiv_op(tk); }
2827	;
2828
2829	// R722
2830	// moved leading optional to level_5_expr
2831	expr
2832	// : ( expr defined_binary_op )? level_5_expr
2833	// : ( level_5_expr defined_binary_op )* level_5_expr
2834	: level_5_expr
2835	{action.expr();}
2836	;
2837
2838	// R723
2839	defined_binary_op returns [Token tk]
2840	: T_DEFINED_OP { tk = $T_DEFINED_OP; action.defined_binary_op(tk); }
2841	;
2842
2843	// R724 inlined logical_expr was expr
2844
2845	// R725 inlined char_expr was expr
2846
2847	// R726 inlined default_char_expr
2848
2849	// R727 inlined int_expr
2850
2851	// R728 inlined numeric_expr was expr
2852
2853	// inlined scalar_numeric_expr was expr
2854
2855	// R729 inlined specification_expr was scalar_int_expr
2856
2857	// R730 inlined initialization_expr
2858
2859	// R731 inlined char_initialization_expr was char_expr
2860
2861	// inlined scalar_char_initialization_expr was char_expr
2862
2863	// R732 inlined int_initialization_expr was int_expr
2864
2865	// inlined scalar_int_initialization_expr was int_initialization_expr
2866
2867	// R733 inlined logical_initialization_expr was logical_expr
2868
2869	// inlined scalar_logical_initialization_expr was logical_expr
2870
2871	// R734
2872	assignment_stmt
2873	@init {Token lbl = null;}
2874	@after{checkForInclude();}
2875	: (label {lbl=$label.tk;})? T_ASSIGNMENT_STMT variable
2876	T_EQUALS expr end_of_stmt
2877	{action.assignment_stmt(lbl, $end_of_stmt.tk);}
2878	;
2879
2880	// R735
2881	// ERR_TEST 735 ensure that part_ref in data_ref doesn't capture the T_LPAREN
2882	// data_pointer_object and proc_pointer_object replaced by designator
2883	// data_target and proc_target replaced by expr
2884	// third alt covered by first alt so proc_pointer_object assignment deleted
2885	// designator (R603), minus the substring part is data_ref, so designator
2886	// replaced by data_ref,
2887	// see NOTE 6.10 for why array-section does not have pointer attribute
2888	// TODO: alt1 and alt3 require the backtracking. if find a way to disambiguate
2889	// them, should be able to remove backtracking.
2890	pointer_assignment_stmt
2891	options {backtrack=true;}
2892	@init {Token lbl = null;}
2893	@after{checkForInclude();}
2894	: (label {lbl=$label.tk;})? T_PTR_ASSIGNMENT_STMT data_ref T_EQ_GT
2895	expr end_of_stmt
2896	{action.pointer_assignment_stmt(lbl, $end_of_stmt.tk,false,false);}
2897	\| (label {lbl=$label.tk;})? T_PTR_ASSIGNMENT_STMT data_ref T_LPAREN
2898	bounds_spec_list T_RPAREN T_EQ_GT expr end_of_stmt
2899	{action.pointer_assignment_stmt(lbl, $end_of_stmt.tk, true,false);}
2900	\| (label {lbl=$label.tk;})? T_PTR_ASSIGNMENT_STMT data_ref T_LPAREN
2901	bounds_remapping_list T_RPAREN T_EQ_GT expr end_of_stmt
2902	{action.pointer_assignment_stmt(lbl, $end_of_stmt.tk, false,true);}
2903	;
2904
2905	// R736
2906	// ERR_CHK 736 ensure ( T_IDENT \| designator ending in T_PERCENT T_IDENT)
2907	// T_IDENT inlined for variable_name and data_pointer_component_name
2908	// variable replaced by designator
2909	data_pointer_object
2910	: designator
2911	{ action.data_pointer_object(); }
2912	;
2913
2914	// R737
2915	// ERR_CHK 737 lower_bound_expr replaced by expr
2916	bounds_spec
2917	: expr T_COLON
2918	{ action.bounds_spec(); }
2919	;
2920
2921	bounds_spec_list
2922	@init{ int count=0;}
2923	: {action.bounds_spec_list__begin();}
2924	bounds_spec {count++;} ( T_COMMA bounds_spec {count++;} )*
2925	{action.bounds_spec_list(count);}
2926	;
2927
2928	// R738
2929	// ERR_CHK 738a lower_bound_expr replaced by expr
2930	// ERR_CHK 738b upper_bound_expr replaced by expr
2931	bounds_remapping
2932	: expr T_COLON expr
2933	{ action.bounds_remapping(); }
2934	;
2935
2936	bounds_remapping_list
2937	@init{ int count=0;}
2938	: {action.bounds_remapping_list__begin();}
2939	bounds_remapping {count++;} ( T_COMMA bounds_remapping {count++;} )*
2940	{action.bounds_remapping_list(count);}
2941	;
2942
2943	// R739 data_target inlined as expr in R459 and R735
2944	// expr can be designator (via primary) so variable deleted
2945
2946	// R740
2947	// ERR_CHK 740 ensure ( T_IDENT \| ends in T_PERCENT T_IDENT )
2948	// T_IDENT inlined for proc_pointer_name
2949	// proc_component_ref replaced by designator T_PERCENT T_IDENT replaced
2950	// by designator
2951	proc_pointer_object
2952	: designator
2953	{ action.proc_pointer_object(); }
2954	;
2955
2956	// R741 proc_component_ref inlined as designator T_PERCENT T_IDENT in R740,
2957	// R742, R1219, and R1221
2958	// T_IDENT inlined for procedure_component_name
2959	// designator inlined for variable
2960
2961	// R742 proc_target inlined as expr in R459 and R735
2962	// ERR_CHK 736 ensure ( expr \| designator ending in T_PERCENT T_IDENT)
2963	// T_IDENT inlined for procedure_name
2964	// T_IDENT isa expr so T_IDENT deleted
2965	// proc_component_ref is variable T_PERCENT T_IDENT can be designator
2966	// so deleted
2967
2968	// R743
2969	// ERR_CHK 743 mask_expr replaced by expr
2970	// assignment_stmt inlined for where_assignment_stmt
2971	where_stmt
2972	@init {
2973	Token lbl = null;
2974	action.where_stmt__begin();
2975	}
2976	@after{checkForInclude();}
2977	:
2978	(label {lbl=$label.tk;})? T_WHERE_STMT T_WHERE
2979	T_LPAREN expr T_RPAREN assignment_stmt
2980	{action.where_stmt(lbl, $T_WHERE);}
2981	;
2982
2983	// R744
2984	where_construct
2985	@init {
2986	int numConstructs = 0;
2987	int numMaskedConstructs = 0;
2988	boolean hasMaskedElsewhere = false;
2989	int numElsewhereConstructs = 0;
2990	boolean hasElsewhere = false;
2991	}
2992	: where_construct_stmt ( where_body_construct {numConstructs += 1;} )*
2993	( masked_elsewhere_stmt ( where_body_construct
2994	{numMaskedConstructs += 1;} )*
2995	{hasMaskedElsewhere = true;
2996	action.masked_elsewhere_stmt__end(numMaskedConstructs);}
2997	)*
2998	( elsewhere_stmt ( where_body_construct
2999	{numElsewhereConstructs += 1;} )*
3000	{hasElsewhere = true;
3001	action.elsewhere_stmt__end(numElsewhereConstructs);}
3002	)?
3003	end_where_stmt
3004	{action.where_construct(numConstructs, hasMaskedElsewhere,
3005	hasElsewhere);}
3006	;
3007
3008	// R745
3009	// ERR_CHK 745 mask_expr replaced by expr
3010	where_construct_stmt
3011	@init {Token id=null;}
3012	@after{checkForInclude();}
3013	: ( T_IDENT T_COLON {id=$T_IDENT;})? T_WHERE_CONSTRUCT_STMT T_WHERE
3014	T_LPAREN expr T_RPAREN end_of_stmt
3015	{action.where_construct_stmt(id, $T_WHERE, $end_of_stmt.tk);}
3016	;
3017
3018	// R746
3019	// assignment_stmt inlined for where_assignment_stmt
3020	where_body_construct
3021	@after {
3022	action.where_body_construct();
3023	}
3024	: assignment_stmt
3025	\| where_stmt
3026	\| where_construct
3027	;
3028
3029	// R747 where_assignment_stmt inlined as assignment_stmt in R743 and R746
3030
3031	// R748 inlined mask_expr was logical_expr
3032
3033	// inlined scalar_mask_expr was scalar_logical_expr
3034
3035	// inlined scalar_logical_expr was logical_expr
3036
3037	// R749
3038	// ERR_CHK 749 mask_expr replaced by expr
3039	masked_elsewhere_stmt
3040	@init {Token lbl = null;Token id=null;}
3041	@after{checkForInclude();}
3042	: (label {lbl=$label.tk;})? T_ELSE T_WHERE T_LPAREN expr T_RPAREN
3043	( T_IDENT {id=$T_IDENT;})? end_of_stmt
3044	{action.masked_elsewhere_stmt(lbl, $T_ELSE, $T_WHERE, id,
3045	$end_of_stmt.tk);}
3046	\| (label {lbl=$label.tk;})? T_ELSEWHERE T_LPAREN expr T_RPAREN
3047	( T_IDENT {id=$T_IDENT;})? end_of_stmt
3048	{action.masked_elsewhere_stmt(lbl, $T_ELSEWHERE, null,id,
3049	$end_of_stmt.tk);}
3050	;
3051
3052	// R750
3053	elsewhere_stmt
3054	@init { Token lbl = null; Token id=null;}
3055	@after{checkForInclude();}
3056	: (label {lbl=$label.tk;})? T_ELSE T_WHERE
3057	(T_IDENT {id=$T_IDENT;})? end_of_stmt
3058	{action.elsewhere_stmt(lbl, $T_ELSE, $T_WHERE, id,
3059	$end_of_stmt.tk);}
3060	\| (label {lbl=$label.tk;})? T_ELSEWHERE (T_IDENT {id=$T_IDENT;})?
3061	end_of_stmt
3062	{action.elsewhere_stmt(lbl, $T_ELSEWHERE, null, id,
3063	$end_of_stmt.tk);}
3064	;
3065
3066	// R751
3067	end_where_stmt
3068	@init {Token lbl = null; Token id=null;} // @init{INIT_TOKEN_NULL(lbl);}
3069	@after{checkForInclude();}
3070	: (label {lbl=$label.tk;})? T_END T_WHERE ( T_IDENT {id=$T_IDENT;} )?
3071	end_of_stmt
3072	{action.end_where_stmt(lbl, $T_END, $T_WHERE, id, $end_of_stmt.tk);}
3073	\| (label {lbl=$label.tk;})? T_ENDWHERE ( T_IDENT {id=$T_IDENT;} )?
3074	end_of_stmt
3075	{action.end_where_stmt(lbl, $T_ENDWHERE, null, id, $end_of_stmt.tk);}
3076	;
3077
3078	// R752
3079	forall_construct
3080	@after {
3081	action.forall_construct();
3082	}
3083	: forall_construct_stmt
3084	( forall_body_construct )*
3085	end_forall_stmt
3086	;
3087
3088	// R753
3089	forall_construct_stmt
3090	@init {Token lbl = null; Token id = null;}
3091	@after{checkForInclude();}
3092	: (label {lbl=$label.tk;})? ( T_IDENT T_COLON {id=$T_IDENT;})?
3093	T_FORALL_CONSTRUCT_STMT T_FORALL
3094	forall_header end_of_stmt
3095	{action.forall_construct_stmt(lbl, id, $T_FORALL,
3096	$end_of_stmt.tk);}
3097	;
3098
3099	// R754
3100	// ERR_CHK 754 scalar_mask_expr replaced by expr
3101	forall_header
3102	@after {
3103	action.forall_header();
3104	}
3105	: T_LPAREN forall_triplet_spec_list ( T_COMMA expr )? T_RPAREN
3106	;
3107
3108	// R755
3109	// T_IDENT inlined for index_name
3110	// expr inlined for subscript and stride
3111	forall_triplet_spec
3112	@init{boolean hasStride=false;}
3113	: T_IDENT T_EQUALS expr T_COLON expr ( T_COLON expr {hasStride=true;})?
3114	{action.forall_triplet_spec($T_IDENT,hasStride);}
3115	;
3116
3117
3118	forall_triplet_spec_list
3119	@init{ int count=0;}
3120	: {action.forall_triplet_spec_list__begin();}
3121	forall_triplet_spec {count++;}
3122	( T_COMMA forall_triplet_spec {count++;} )*
3123	{action.forall_triplet_spec_list(count);}
3124	;
3125
3126	// R756
3127	forall_body_construct
3128	@after {
3129	action.forall_body_construct();
3130	}
3131	: forall_assignment_stmt
3132	\| where_stmt
3133	\| where_construct
3134	\| forall_construct
3135	\| forall_stmt
3136	;
3137
3138	// R757
3139	forall_assignment_stmt
3140	@after{checkForInclude();}
3141	: assignment_stmt
3142	{action.forall_assignment_stmt(false);}
3143	\| pointer_assignment_stmt
3144	{action.forall_assignment_stmt(true);}
3145	;
3146
3147	// R758
3148	end_forall_stmt
3149	@init {Token lbl = null; Token id=null;}
3150	@after{checkForInclude();}
3151	: (label {lbl=$label.tk;})? T_END T_FORALL ( T_IDENT {id=$T_IDENT;})?
3152	end_of_stmt
3153	{action.end_forall_stmt(lbl, $T_END, $T_FORALL, id, $end_of_stmt.tk);}
3154	\| (label {lbl=$label.tk;})? T_ENDFORALL ( T_IDENT {id=$T_IDENT;})?
3155	end_of_stmt
3156	{action.end_forall_stmt(lbl, $T_ENDFORALL, null, id, $end_of_stmt.tk);}
3157	;
3158
3159	// R759
3160	// T_FORALL_STMT token is inserted by scanner to remove need for backtracking
3161	forall_stmt
3162	@init {
3163	Token lbl = null;
3164	action.forall_stmt__begin();
3165	}
3166	@after{checkForInclude();}
3167	: (label {lbl=$label.tk;})? T_FORALL_STMT T_FORALL
3168	forall_header
3169	forall_assignment_stmt
3170	{action.forall_stmt(lbl, $T_FORALL);}
3171	;
3172
3173	/*
3174	* Section 8:
3175	*/
3176
3177	// R801
3178	block
3179	@after {
3180	action.block();
3181	}
3182	: ( execution_part_construct )*
3183	;
3184
3185	// R802
3186	if_construct
3187	@after {
3188	action.if_construct();
3189	}
3190	: if_then_stmt block ( else_if_stmt block )* ( else_stmt block )?
3191	end_if_stmt
3192	;
3193
3194	// R803
3195	// ERR_CHK 803 scalar_logical_expr replaced by expr
3196	if_then_stmt
3197	@init {Token lbl = null; Token id=null;}
3198	@after{checkForInclude();}
3199	: (label {lbl=$label.tk;})? ( T_IDENT T_COLON {id=$T_IDENT;} )? T_IF
3200	T_LPAREN expr T_RPAREN T_THEN end_of_stmt
3201	{action.if_then_stmt(lbl, id, $T_IF, $T_THEN, $end_of_stmt.tk);}
3202	;
3203
3204	// R804
3205	// ERR_CHK 804 scalar_logical_expr replaced by expr
3206	else_if_stmt
3207	@init {Token lbl = null; Token id=null;}
3208	@after{checkForInclude();}
3209	: (label {lbl=$label.tk;})? T_ELSE T_IF
3210	T_LPAREN expr T_RPAREN T_THEN ( T_IDENT {id=$T_IDENT;} )? end_of_stmt
3211	{action.else_if_stmt(lbl, $T_ELSE, $T_IF, $T_THEN, id,
3212	$end_of_stmt.tk);}
3213	\| (label {lbl=$label.tk;})? T_ELSEIF
3214	T_LPAREN expr T_RPAREN T_THEN ( T_IDENT {id=$T_IDENT;} )? end_of_stmt
3215	{action.else_if_stmt(lbl, $T_ELSEIF, null, $T_THEN, id,
3216	$end_of_stmt.tk);}
3217	;
3218
3219	// R805
3220	else_stmt
3221	@init {Token lbl = null; Token id=null;}
3222	@after{checkForInclude();}
3223	: (label {lbl=$label.tk;})? T_ELSE ( T_IDENT {id=$T_IDENT;} )?
3224	end_of_stmt
3225	{action.else_stmt(lbl, $T_ELSE, id, $end_of_stmt.tk);}
3226	;
3227
3228	// R806
3229	end_if_stmt
3230	@init {Token lbl = null; Token id=null;}
3231	@after{checkForInclude();}
3232	: (label {lbl=$label.tk;})? T_END T_IF ( T_IDENT {id=$T_IDENT;} )?
3233	end_of_stmt
3234	{action.end_if_stmt(lbl, $T_END, $T_IF, id, $end_of_stmt.tk);}
3235	\| (label {lbl=$label.tk;})? T_ENDIF ( T_IDENT {id=$T_IDENT;} )?
3236	end_of_stmt
3237	{action.end_if_stmt(lbl, $T_ENDIF, null, id, $end_of_stmt.tk);}
3238	;
3239
3240	// R807
3241	// ERR_CHK 807 scalar_logical_expr replaced by expr
3242	// T_IF_STMT inserted by scanner to remove need for backtracking
3243	if_stmt
3244	@init {
3245	Token lbl = null;
3246	action.if_stmt__begin();
3247	}
3248	@after{checkForInclude();}
3249	: (label {lbl=$label.tk;})? T_IF_STMT T_IF T_LPAREN expr T_RPAREN
3250	action_stmt
3251	{action.if_stmt(lbl, $T_IF);}
3252	;
3253
3254	// R808
3255	case_construct
3256	@after {
3257	action.case_construct();
3258	}
3259	: select_case_stmt ( case_stmt block )* end_select_stmt
3260	;
3261
3262	// R809
3263	// ERR_CHK 809 case_expr replaced by expr
3264	select_case_stmt
3265	@init {Token lbl = null; Token id=null; Token tk1 = null; Token tk2 = null;}
3266	@after{checkForInclude();}
3267	: (label {lbl=$label.tk;})? ( T_IDENT T_COLON {id=$T_IDENT;})?
3268	(T_SELECT T_CASE {tk1=$T_SELECT; tk2=$T_CASE;}
3269	\| T_SELECTCASE {tk1=$T_SELECTCASE; tk2=null;} )
3270	T_LPAREN expr T_RPAREN end_of_stmt
3271	{action.select_case_stmt(lbl, id, tk1, tk2, $end_of_stmt.tk);}
3272	;
3273
3274	// R810
3275	case_stmt
3276	@init {Token lbl = null; Token id=null;}
3277	@after{checkForInclude();}
3278	: (label {lbl=$label.tk;})? T_CASE case_selector
3279	( T_IDENT {id=$T_IDENT;})? end_of_stmt
3280	{ action.case_stmt(lbl, $T_CASE, id, $end_of_stmt.tk);}
3281	;
3282
3283	// R811
3284	end_select_stmt
3285	@init {Token lbl = null; Token id=null;}
3286	@after{checkForInclude();}
3287	: (label {lbl=$label.tk;})? T_END T_SELECT (T_IDENT {id=$T_IDENT;})?
3288	end_of_stmt
3289	{action.end_select_stmt(lbl, $T_END, $T_SELECT, id,
3290	$end_of_stmt.tk);}
3291	\| (label {lbl=$label.tk;})? T_ENDSELECT (T_IDENT {id=$T_IDENT;})?
3292	end_of_stmt
3293	{action.end_select_stmt(lbl, $T_ENDSELECT, null, id,
3294	$end_of_stmt.tk);}
3295	;
3296
3297	// R812 inlined case_expr with expr was either scalar_int_expr
3298	// scalar_char_expr scalar_logical_expr
3299
3300	// inlined scalar_char_expr with expr was char_expr
3301
3302	// R813
3303	case_selector
3304	: T_LPAREN
3305	case_value_range_list
3306	T_RPAREN
3307	{ action.case_selector(null); }
3308	\| T_DEFAULT
3309	{ action.case_selector($T_DEFAULT); }
3310	;
3311
3312	// R814
3313	case_value_range
3314	@after {
3315	action.case_value_range();
3316	}
3317	: T_COLON case_value
3318	\| case_value case_value_range_suffix
3319	;
3320
3321	case_value_range_suffix
3322	@after {
3323	action.case_value_range_suffix();
3324	}
3325	: T_COLON ( case_value )?
3326	\| { /* empty */ }
3327	;
3328
3329	case_value_range_list
3330	@init{ int count=0;}
3331	: {action.case_value_range_list__begin();}
3332	case_value_range {count++;} ( T_COMMA case_value_range {count++;} )*
3333	{action.case_value_range_list(count);}
3334	;
3335
3336	// R815
3337	// ERR_CHK 815 expr either scalar_int_initialization_expr
3338	// scalar_char_initialization_expr scalar_logical_initialization_expr
3339	case_value
3340	: expr
3341	{ action.case_value(); }
3342	;
3343
3344	// R816
3345	associate_construct
3346	: associate_stmt
3347	block
3348	end_associate_stmt
3349	{ action.associate_construct(); }
3350	;
3351
3352	// R817
3353	associate_stmt
3354	@init {Token lbl = null; Token id=null;}
3355	@after{checkForInclude();}
3356	: (label {lbl=$label.tk;})? ( T_IDENT T_COLON {id=$T_IDENT;})?
3357	T_ASSOCIATE T_LPAREN association_list T_RPAREN end_of_stmt
3358	{action.associate_stmt(lbl, id, $T_ASSOCIATE, $end_of_stmt.tk);}
3359	;
3360
3361	association_list
3362	@init{ int count=0;}
3363	: {action.association_list__begin();}
3364	association {count++;} ( T_COMMA association {count++;} )*
3365	{action.association_list(count);}
3366	;
3367
3368	// R818
3369	// T_IDENT inlined for associate_name
3370	association
3371	: T_IDENT T_EQ_GT selector
3372	{ action.association($T_IDENT); }
3373	;
3374
3375	// R819
3376	// expr can be designator (via primary) so variable deleted
3377	selector
3378	: expr
3379	{ action.selector(); }
3380	;
3381
3382	// R820
3383	end_associate_stmt
3384	@init {Token lbl = null; Token id=null;}
3385	@after{checkForInclude();}
3386	: (label {lbl=$label.tk;})? T_END T_ASSOCIATE
3387	(T_IDENT {id=$T_IDENT;})? end_of_stmt
3388	{action.end_associate_stmt(lbl, $T_END, $T_ASSOCIATE, id,
3389	$end_of_stmt.tk);}
3390	\| (label {lbl=$label.tk;})? T_ENDASSOCIATE
3391	(T_IDENT {id=$T_IDENT;})? end_of_stmt
3392	{action.end_associate_stmt(lbl, $T_ENDASSOCIATE, null, id,
3393	$end_of_stmt.tk);}
3394	;
3395
3396	// R821
3397	select_type_construct
3398	: select_type_stmt ( type_guard_stmt block )* end_select_type_stmt
3399	{ action.select_type_construct(); }
3400	;
3401
3402	// R822
3403	// T_IDENT inlined for select_construct_name and associate_name
3404	select_type_stmt
3405	@init {Token lbl = null; Token selectConstructName=null;
3406	Token associateName=null;}
3407	@after{checkForInclude();}
3408	: (label {lbl=$label.tk;})?
3409	( idTmp=T_IDENT T_COLON {selectConstructName=idTmp;})? select_type
3410	T_LPAREN ( idTmpx=T_IDENT T_EQ_GT {associateName=idTmpx;} )?
3411	selector T_RPAREN end_of_stmt
3412	{action.select_type_stmt(lbl, selectConstructName, associateName,
3413	$end_of_stmt.tk);}
3414	;
3415
3416	select_type
3417	: T_SELECT T_TYPE { action.select_type($T_SELECT, $T_TYPE); }
3418	\| T_SELECTTYPE { action.select_type($T_SELECTTYPE, null); }
3419	;
3420
3421	// R823
3422	// T_IDENT inlined for select_construct_name
3423	// TODO - FIXME - have to remove T_TYPE_IS and T_CLASS_IS because the
3424	// lexer never matches the sequences. lexer now matches a T_IDENT for
3425	// the 'IS'. this rule should be fixed (see test_select_stmts.f03)
3426	// TODO - The temporary token seems convoluted, but I couldn't figure out
3427	// how to prevent ambiguous use of T_IDENT otherwise. -BMR
3428	type_guard_stmt
3429	@init {Token lbl = null; Token selectConstructName=null;}
3430	@after{checkForInclude();}
3431	: (label {lbl=$label.tk;})? T_TYPE id1=T_IDENT
3432	T_LPAREN type_spec T_RPAREN
3433	( idTmp=T_IDENT {selectConstructName=idTmp;})? end_of_stmt
3434	{action.type_guard_stmt(lbl, $T_TYPE, id1, selectConstructName,
3435	$end_of_stmt.tk);}
3436	\| (label {lbl=$label.tk;})? T_CLASS id1=T_IDENT
3437	T_LPAREN type_spec T_RPAREN
3438	( idTmp=T_IDENT {selectConstructName=idTmp;})? end_of_stmt
3439	{action.type_guard_stmt(lbl, $T_CLASS, id1, selectConstructName,
3440	$end_of_stmt.tk);}
3441	\| (label {lbl=$label.tk;})? T_CLASS T_DEFAULT
3442	( idTmp=T_IDENT {selectConstructName=idTmp;})? end_of_stmt
3443	{action.type_guard_stmt(lbl, $T_CLASS, $T_DEFAULT,
3444	selectConstructName, $end_of_stmt.tk);}
3445	;
3446
3447	// R824
3448	// T_IDENT inlined for select_construct_name
3449	end_select_type_stmt
3450	@init {Token lbl = null; Token id = null;}
3451	@after{checkForInclude();}
3452	: (label {lbl=$label.tk;})? T_END T_SELECT
3453	( T_IDENT {id=$T_IDENT;})? end_of_stmt
3454	{action.end_select_type_stmt(lbl, $T_END, $T_SELECT, id,
3455	$end_of_stmt.tk);}
3456	\| (label {lbl=$label.tk;})? T_ENDSELECT
3457	( T_IDENT {id=$T_IDENT;})? end_of_stmt
3458	{action.end_select_type_stmt(lbl, $T_ENDSELECT, null, id,
3459	$end_of_stmt.tk);}
3460	;
3461
3462	// R825
3463	// deleted second alternative, nonblock_do_construct, to reduce backtracking, see comments for R835 on how
3464	// termination of nested loops must be handled.
3465	do_construct
3466	: block_do_construct
3467	{ action.do_construct(); }
3468	;
3469
3470	// R826
3471	// do_block replaced by block
3472	block_do_construct
3473	: do_stmt
3474	block
3475	end_do
3476	{ action.block_do_construct(); }
3477	;
3478
3479	// R827
3480	// label_do_stmt and nonlabel_do_stmt inlined
3481	do_stmt
3482	@init {Token lbl = null;
3483	Token id=null;
3484	Token digitString=null;
3485	boolean hasLoopControl=false;}
3486	@after{checkForInclude();}
3487	: (label {lbl=$label.tk;})? ( T_IDENT T_COLON {id=$T_IDENT;})? T_DO
3488	( T_DIGIT_STRING {digitString=$T_DIGIT_STRING;})?
3489	( loop_control {hasLoopControl=true;})? end_of_stmt
3490	{action.do_stmt(lbl, id, $T_DO, digitString, $end_of_stmt.tk,
3491	hasLoopControl);}
3492	;
3493
3494	// R828
3495	// T_IDENT inlined for do_construct_name
3496	// T_DIGIT_STRING inlined for label
3497	label_do_stmt
3498	@init {Token lbl = null; Token id=null; boolean hasLoopControl=false;}
3499	@after{checkForInclude();}
3500	: (label {lbl=$label.tk;})? ( T_IDENT T_COLON {id=$T_IDENT;} )?
3501	T_DO T_DIGIT_STRING ( loop_control {hasLoopControl=true;})?
3502	end_of_stmt
3503	{action.label_do_stmt(lbl, id, $T_DO, $T_DIGIT_STRING,
3504	$end_of_stmt.tk, hasLoopControl);}
3505	;
3506
3507	// R829 inlined in R827
3508	// T_IDENT inlined for do_construct_name
3509
3510	// R830
3511	// ERR_CHK 830a scalar_int_expr replaced by expr
3512	// ERR_CHK 830b scalar_logical_expr replaced by expr
3513	loop_control
3514	@init {boolean hasOptExpr = false;}
3515	: ( T_COMMA )? T_WHILE T_LPAREN expr T_RPAREN
3516	{action.loop_control($T_WHILE, IActionEnums.DoConstruct_while, hasOptExpr);}
3517	\| ( T_COMMA )? do_variable T_EQUALS expr T_COMMA expr
3518	( T_COMMA expr { hasOptExpr = true; })?
3519	{action.loop_control(null, IActionEnums.DoConstruct_variable, hasOptExpr);}
3520	;
3521
3522	// R831
3523	do_variable
3524	: scalar_int_variable
3525	{ action.do_variable(); }
3526	;
3527
3528	// R832 do_block was block inlined in R826
3529
3530	// R833
3531	// TODO continue-stmt is ambiguous with same in action statement, check
3532	// there for label and if
3533	// label matches do-stmt label, then match end-do
3534	// do_term_action_stmt added to allow block_do_construct to cover
3535	// nonblock_do_construct as well
3536	end_do
3537	@after {
3538	action.end_do();
3539	}
3540	: end_do_stmt
3541	\| do_term_action_stmt
3542	;
3543
3544	// R834
3545	// T_IDENT inlined for do_construct_name
3546	end_do_stmt
3547	@init {Token lbl = null; Token id=null;}
3548	@after{checkForInclude();}
3549	: (label {lbl=$label.tk;})? T_END T_DO ( T_IDENT {id=$T_IDENT;})?
3550	end_of_stmt
3551	{action.end_do_stmt(lbl, $T_END, $T_DO, id, $end_of_stmt.tk);}
3552	\| (label {lbl=$label.tk;})? T_ENDDO ( T_IDENT {id=$T_IDENT;})?
3553	end_of_stmt
3554	{action.end_do_stmt(lbl, $T_ENDDO, null, id, $end_of_stmt.tk);}
3555	;
3556
3557	// R835 nonblock_do_construct deleted as it was combined with
3558	// block_do_construct to reduce backtracking
3559	// Second alternative, outer_shared_do_construct (nested loops sharing a
3560	// termination label) is ambiguous
3561	// with do_construct in do_body, so deleted. Loop termination will have to
3562	// be coordinated with
3563	// the scanner to unwind nested loops sharing a common termination statement
3564	// (see do_term_action_stmt).
3565
3566	// R836 action_term_do_construct deleted because nonblock_do_construct
3567	// combined with block_do_construct to reduce backtracking
3568
3569	// R837 do_body deleted because nonblock_do_construct combined with
3570	// block_do_construct to reduce backtracking
3571
3572	// R838
3573	// C826 (R842) A do-term-shared-stmt shall not be a goto-stmt, a return-stmt,
3574	// a stop-stmt, an exit-stmt, a cyle-stmt, an end-function-stmt, an
3575	// end-subroutine-stmt, an end-program-stmt, or an arithmetic-if-stmt.
3576	// TODO need interaction with scanner to have this extra terminal emitted
3577	// when do label matched
3578	// TODO need interaction with scanner to terminate shared terminal action
3579	// statements (see R835).
3580	do_term_action_stmt
3581	@init { Token id=null; Token endToken = null; Token doToken = null;}
3582	@after{checkForInclude();}
3583	// try requiring an action_stmt and then we can simply insert the new
3584	// T_LABEL_DO_TERMINAL during the Sale's prepass. T_EOS is in action_stmt.
3585	// added the T_END T_DO and T_ENDDO options to this rule because of the
3586	// token T_LABEL_DO_TERMINAL that is inserted if they end a labeled DO.
3587	: label T_LABEL_DO_TERMINAL
3588	(action_stmt \| ( (T_END T_DO {endToken=$T_END; doToken=$T_DO;}
3589	\| T_ENDDO {endToken=$T_ENDDO; doToken=null;})
3590	(T_IDENT {id=$T_IDENT;})?) end_of_stmt)
3591	// BMR- Has to massage the rule a little bit to convince Antlr that thre aren't potentially two identifiers here. Original is below.
3592	// (action_stmt \| ( (T_END T_DO (T_IDENT {id=$T_IDENT;})?) \| (T_ENDDO) (T_IDENT {id=$T_IDENT;})? ) T_EOS)
3593	{action.do_term_action_stmt($label.tk, endToken, doToken, id,
3594	$end_of_stmt.tk);}
3595	// : T_LABEL_DO_TERMINAL action_stmt
3596	// : T_LABEL_DO_TERMINAL action_or_cont_stmt
3597	;
3598
3599	// R839 outer_shared_do_construct removed because it caused ambiguity in
3600	// R835 (see comment in R835)
3601
3602	// R840 shared_term_do_construct deleted (see comments for R839 and R835)
3603
3604	// R841 inner_shared_do_construct deleted (see comments for R839 and R835)
3605
3606	// R842 do_term_shared_stmt deleted (see comments for R839 and R835)
3607
3608	// R843
3609	// T_IDENT inlined for do_construct_name
3610	cycle_stmt
3611	@init {Token lbl = null; Token id = null;}
3612	@after{checkForInclude();}
3613	: (label {lbl=$label.tk;})? T_CYCLE (T_IDENT {id=$T_IDENT;})? end_of_stmt
3614	{ action.cycle_stmt(lbl, $T_CYCLE, id, $end_of_stmt.tk); }
3615	;
3616
3617	// R844
3618	// T_IDENT inlined for do_construct_name
3619	exit_stmt
3620	@init {Token lbl = null; Token id = null;}
3621	@after{checkForInclude();}
3622	: (label {lbl=$label.tk;})? T_EXIT (T_IDENT {id=$T_IDENT;})? end_of_stmt
3623	{ action.exit_stmt(lbl, $T_EXIT, id, $end_of_stmt.tk); }
3624	;
3625
3626	// R845
3627	goto_stmt
3628	@init {Token goKeyword=null; Token toKeyword=null;}
3629	@after{checkForInclude();}
3630	: (T_GO T_TO { goKeyword=$T_GO; toKeyword=$T_TO;}
3631	\| T_GOTO { goKeyword=$T_GOTO; toKeyword=null;})
3632	label end_of_stmt
3633	{ action.goto_stmt(goKeyword, toKeyword, $label.tk,
3634	$end_of_stmt.tk); }
3635	;
3636
3637	// R846
3638	// ERR_CHK 846 scalar_int_expr replaced by expr
3639	computed_goto_stmt
3640	@init {Token lbl = null; Token goKeyword=null; Token toKeyword=null;}
3641	@after{checkForInclude();}
3642	: (label {lbl=$label.tk;})?
3643	(T_GO T_TO {goKeyword=$T_GO; toKeyword=$T_TO;}
3644	\| T_GOTO {goKeyword=$T_GOTO; toKeyword=null;})
3645	T_LPAREN label_list T_RPAREN ( T_COMMA )? expr end_of_stmt
3646	{ action.computed_goto_stmt(lbl, goKeyword, toKeyword,
3647	$end_of_stmt.tk); }
3648	;
3649
3650	// The ASSIGN statement is a deleted feature.
3651	assign_stmt
3652	@after{checkForInclude();}
3653	: (lbl1=label)? T_ASSIGN lbl2=label T_TO name end_of_stmt
3654	{ action.assign_stmt(lbl1, $T_ASSIGN, lbl2, $T_TO, $name.tk,
3655	$end_of_stmt.tk); }
3656	;
3657
3658	// The assigned GOTO statement is a deleted feature.
3659	assigned_goto_stmt
3660	@init {Token goKeyword=null; Token toKeyword=null;}
3661	@after{checkForInclude();}
3662	: (label)? ( T_GOTO {goKeyword=$T_GOTO; toKeyword=null;}
3663	\| T_GO T_TO {goKeyword=$T_GO; toKeyword=$T_TO;} )
3664	name (T_COMMA stmt_label_list)? end_of_stmt
3665	{ action.assigned_goto_stmt($label.tk, goKeyword, toKeyword,
3666	$name.tk, $end_of_stmt.tk); }
3667	;
3668
3669	// Used with assigned_goto_stmt (deleted feature)
3670	stmt_label_list
3671	: T_LPAREN label ( T_COMMA label )* T_RPAREN
3672	{ action.stmt_label_list(); }
3673	;
3674
3675	// The PAUSE statement is a deleted feature.
3676	pause_stmt
3677	@init {Token tmpToken=null;}
3678	@after{checkForInclude();}
3679	: (lbl1=label)? T_PAUSE (lbl2=label {tmpToken=lbl2;}
3680	\| char_literal_constant {tmpToken=null;})? end_of_stmt
3681	{ action.pause_stmt(lbl1, $T_PAUSE, tmpToken,
3682	$end_of_stmt.tk); }
3683	;
3684
3685	// R847
3686	// ERR_CHK 847 scalar_numeric_expr replaced by expr
3687	arithmetic_if_stmt
3688	@after{checkForInclude();}
3689	: (lbl=label)? T_ARITHMETIC_IF_STMT T_IF
3690	T_LPAREN expr T_RPAREN label1=label
3691	T_COMMA label2=label
3692	T_COMMA label3=label end_of_stmt
3693	{ action.arithmetic_if_stmt(lbl, $T_IF, label1, label2, label3,
3694	$end_of_stmt.tk); }
3695	;
3696
3697	// R848 continue_stmt
3698	continue_stmt
3699	@init {Token lbl = null;}
3700	@after{checkForInclude();}
3701	: (label {lbl=$label.tk;})? T_CONTINUE end_of_stmt
3702	{ action.continue_stmt(lbl, $T_CONTINUE, $end_of_stmt.tk); }
3703	;
3704
3705	// R849
3706	stop_stmt
3707	@init {Token lbl = null; boolean hasStopCode = false;}
3708	@after{checkForInclude();}
3709	: (label {lbl=$label.tk;})? T_STOP (stop_code {hasStopCode=true;})?
3710	end_of_stmt
3711	{ action.stop_stmt(lbl, $T_STOP, $end_of_stmt.tk, hasStopCode); }
3712	;
3713
3714	// R850
3715	// ERR_CHK 850 T_DIGIT_STRING must be 5 digits or less
3716	stop_code
3717	: scalar_char_constant
3718	{ action.stop_code(null); }
3719	// \| Digit ( Digit ( Digit ( Digit ( Digit )? )? )? )?
3720	\| T_DIGIT_STRING
3721	{ action.stop_code($T_DIGIT_STRING); }
3722	;
3723
3724	scalar_char_constant
3725	: char_constant
3726	{ action.scalar_char_constant(); }
3727	;
3728
3729	/*
3730	Section 9:
3731	*/
3732
3733	// R901
3734	// file_unit_number replaced by expr
3735	// internal_file_variable isa expr so internal_file_variable deleted
3736	io_unit
3737	@after {
3738	action.io_unit();
3739	}
3740	: expr
3741	\| T_ASTERISK
3742	;
3743
3744	// R902
3745	// ERR_CHK 902 scalar_int_expr replaced by expr
3746	file_unit_number
3747	@after {
3748	action.file_unit_number();
3749	}
3750	: expr
3751	;
3752
3753	// R903 internal_file_variable was char_variable inlined (and then deleted)
3754	// in R901
3755
3756	// R904
3757	open_stmt
3758	@init {Token lbl = null;}
3759	@after{checkForInclude();}
3760	: (label {lbl=$label.tk;})? T_OPEN T_LPAREN connect_spec_list
3761	T_RPAREN end_of_stmt
3762	{action.open_stmt(lbl, $T_OPEN, $end_of_stmt.tk);}
3763	;
3764
3765	// R905
3766	// ERR_CHK 905 check expr type with identifier
3767	connect_spec
3768	: expr
3769	{ action.connect_spec(null); }
3770	\| T_IDENT
3771	/* {'UNIT','ACCESS','ACTION','ASYNCHRONOUS','BLANK','DECIMAL', */
3772	/* 'DELIM','ENCODING'} are expr */
3773	/* {'ERR'} is T_DIGIT_STRING */
3774	/* {'FILE','FORM'} are expr */
3775	/* {'IOMSG','IOSTAT'} are variables */
3776	/* {'PAD','POSITION','RECL','ROUND','SIGN','STATUS'} are expr */
3777	T_EQUALS expr
3778	{ action.connect_spec($T_IDENT); }
3779	;
3780
3781	connect_spec_list
3782	@init{ int count=0;}
3783	: {action.connect_spec_list__begin();}
3784	connect_spec {count++;} ( T_COMMA connect_spec {count++;} )*
3785	{action.connect_spec_list(count);}
3786	;
3787
3788	// inlined scalar_default_char_expr
3789
3790	// R906 inlined file_name_expr with expr was scalar_default_char_expr
3791
3792	// R907 iomsg_variable inlined as scalar_default_char_variable in
3793	// R905,R909,R913,R922,R926,R928
3794
3795	// R908
3796	close_stmt
3797	@init {Token lbl = null;}
3798	@after{checkForInclude();}
3799	: (label {lbl=$label.tk;})? T_CLOSE T_LPAREN close_spec_list
3800	T_RPAREN end_of_stmt
3801	{action.close_stmt(lbl, $T_CLOSE, $end_of_stmt.tk);}
3802	;
3803
3804	// R909
3805	// file_unit_number, scalar_int_variable, iomsg_variable, label replaced
3806	// by expr
3807	close_spec
3808	: expr
3809	{ action.close_spec(null); }
3810	\| T_IDENT /* {'UNIT','IOSTAT','IOMSG','ERR','STATUS'} */ T_EQUALS expr
3811	{ action.close_spec($T_IDENT); }
3812	;
3813
3814	close_spec_list
3815	@init{ int count=0;}
3816	: {action.close_spec_list__begin();}
3817	close_spec {count++;} ( T_COMMA close_spec {count++;} )*
3818	{action.close_spec_list(count);}
3819	;
3820
3821	// R910
3822	read_stmt
3823	options {k=3;}
3824	@init {Token lbl = null; boolean hasInputItemList=false;}
3825	@after{checkForInclude();}
3826	: ((label)? T_READ T_LPAREN) =>
3827	(label {lbl=$label.tk;})? T_READ T_LPAREN io_control_spec_list
3828	T_RPAREN ( input_item_list {hasInputItemList=true;})? end_of_stmt
3829	{action.read_stmt(lbl, $T_READ, $end_of_stmt.tk,
3830	hasInputItemList);}
3831	\| ((label)? T_READ) =>
3832	(label {lbl=$label.tk;})? T_READ format
3833	( T_COMMA input_item_list {hasInputItemList=true;})? end_of_stmt
3834	{action.read_stmt(lbl, $T_READ, $end_of_stmt.tk,
3835	hasInputItemList);}
3836	;
3837
3838	// R911
3839	write_stmt
3840	@init {Token lbl = null; boolean hasOutputItemList=false;}
3841	@after{checkForInclude();}
3842	: (label {lbl=$label.tk;})? T_WRITE T_LPAREN io_control_spec_list
3843	T_RPAREN ( output_item_list {hasOutputItemList=true;})? end_of_stmt
3844	{ action.write_stmt(lbl, $T_WRITE, $end_of_stmt.tk,
3845	hasOutputItemList); }
3846	;
3847
3848	// R912
3849	print_stmt
3850	@init {Token lbl = null; boolean hasOutputItemList=false;}
3851	@after{checkForInclude();}
3852	: (label {lbl=$label.tk;})? T_PRINT format
3853	( T_COMMA output_item_list {hasOutputItemList=true;})? end_of_stmt
3854	{ action.print_stmt(lbl, $T_PRINT, $end_of_stmt.tk,
3855	hasOutputItemList); }
3856	;
3857
3858	// R913
3859	// ERR_CHK 913 check expr type with identifier
3860	// io_unit and format are both (expr\|'*') so combined
3861	io_control_spec
3862	: expr
3863	// hasExpression=true
3864	{ action.io_control_spec(true, null, false); }
3865	\| T_ASTERISK
3866	// hasAsterisk=true
3867	{ action.io_control_spec(false, null, true); }
3868	\| T_IDENT /* {'UNIT','FMT'} */ T_EQUALS T_ASTERISK
3869	// hasAsterisk=true
3870	{ action.io_control_spec(false, $T_IDENT, true); }
3871	\| T_IDENT
3872	/* {'UNIT','FMT'} are expr 'NML' is T_IDENT} */
3873	/* {'ADVANCE','ASYNCHRONOUS','BLANK','DECIMAL','DELIM'} are expr */
3874	/* {'END','EOR','ERR'} are labels */
3875	/* {'ID','IOMSG',IOSTAT','SIZE'} are variables */
3876	/* {'PAD','POS','REC','ROUND','SIGN'} are expr */
3877	T_EQUALS expr
3878	// hasExpression=true
3879	{ action.io_control_spec(true, $T_IDENT, false); }
3880	;
3881
3882
3883	io_control_spec_list
3884	@init{ int count=0;}
3885	: {action.io_control_spec_list__begin();}
3886	io_control_spec {count++;} ( T_COMMA io_control_spec {count++;} )*
3887	{action.io_control_spec_list(count);}
3888	;
3889
3890	// R914
3891	// ERR_CHK 914 default_char_expr replaced by expr
3892	// label replaced by T_DIGIT_STRING is expr so deleted
3893	format
3894	@after {
3895	action.format();
3896	}
3897	: expr
3898	\| T_ASTERISK
3899	;
3900
3901	// R915
3902	input_item
3903	@after {
3904	action.input_item();
3905	}
3906	: variable
3907	\| io_implied_do
3908	;
3909
3910	input_item_list
3911	@init{ int count=0;}
3912	: {action.input_item_list__begin();}
3913	input_item {count++;} ( T_COMMA input_item {count++;} )*
3914	{action.input_item_list(count);}
3915	;
3916
3917	// R916
3918	output_item
3919	options {backtrack=true;}
3920	@after {
3921	action.output_item();
3922	}
3923	: expr
3924	\| io_implied_do
3925	;
3926
3927
3928	output_item_list
3929	@init{ int count=0;}
3930	: {action.output_item_list__begin();}
3931	output_item {count++;} ( T_COMMA output_item {count++;} )*
3932	{action.output_item_list(count);}
3933	;
3934
3935	// R917
3936	io_implied_do
3937	: T_LPAREN io_implied_do_object io_implied_do_suffix T_RPAREN
3938	{ action.io_implied_do(); }
3939	;
3940
3941	// R918
3942	// expr in output_item can be variable in input_item so input_item deleted
3943	io_implied_do_object
3944	: output_item
3945	{ action.io_implied_do_object(); }
3946	;
3947
3948	io_implied_do_suffix
3949	options {backtrack=true;}
3950	: T_COMMA io_implied_do_object io_implied_do_suffix
3951	\| T_COMMA io_implied_do_control
3952	;
3953
3954	// R919
3955	// ERR_CHK 919 scalar_int_expr replaced by expr
3956	io_implied_do_control
3957	: do_variable T_EQUALS expr T_COMMA expr ( T_COMMA expr )?
3958	{ action.io_implied_do_control(); }
3959	;
3960
3961	// R920
3962	// TODO: remove this? it is never called.
3963	dtv_type_spec
3964	: T_TYPE
3965	T_LPAREN
3966	derived_type_spec
3967	T_RPAREN
3968	{ action.dtv_type_spec($T_TYPE); }
3969	\| T_CLASS
3970	T_LPAREN
3971	derived_type_spec
3972	T_RPAREN
3973	{ action.dtv_type_spec($T_CLASS); }
3974	;
3975
3976	// R921
3977	wait_stmt
3978	@init {Token lbl = null;}
3979	@after{checkForInclude();}
3980	: (label {lbl=$label.tk;})? T_WAIT T_LPAREN wait_spec_list T_RPAREN
3981	end_of_stmt
3982	{action.wait_stmt(lbl, $T_WAIT, $end_of_stmt.tk);}
3983	;
3984
3985	// R922
3986	// file_unit_number, scalar_int_variable, iomsg_variable, label replaced
3987	// by expr
3988	wait_spec
3989	: expr
3990	{ action.wait_spec(null); }
3991	\| T_IDENT /* {'UNIT','END','EOR','ERR','ID','IOMSG','IOSTAT'} */
3992	T_EQUALS expr
3993	{ action.wait_spec($T_IDENT); }
3994	;
3995
3996
3997	wait_spec_list
3998	@init{ int count=0;}
3999	: {action.wait_spec_list__begin();}
4000	wait_spec {count++;} ( T_COMMA wait_spec {count++;} )*
4001	{action.wait_spec_list(count);}
4002	;
4003
4004	// R923
4005	backspace_stmt
4006	options {k=3;}
4007	@init {Token lbl = null;}
4008	@after{checkForInclude();}
4009	: ((label)? T_BACKSPACE T_LPAREN) =>
4010	(label {lbl=$label.tk;})? T_BACKSPACE T_LPAREN position_spec_list
4011	T_RPAREN end_of_stmt
4012	{action.backspace_stmt(lbl, $T_BACKSPACE, $end_of_stmt.tk, true);}
4013	\| ((label)? T_BACKSPACE) =>
4014	(label {lbl=$label.tk;})? T_BACKSPACE file_unit_number end_of_stmt
4015	{action.backspace_stmt(lbl, $T_BACKSPACE, $end_of_stmt.tk, false);}
4016	;
4017
4018	// R924
4019	endfile_stmt
4020	options {k=3;}
4021	@init {Token lbl = null;}
4022	@after{checkForInclude();}
4023	: ((label)? T_END T_FILE T_LPAREN) =>
4024	(label {lbl=$label.tk;})? T_END T_FILE T_LPAREN position_spec_list
4025	T_RPAREN end_of_stmt
4026	{action.endfile_stmt(lbl, $T_END, $T_FILE, $end_of_stmt.tk, true);}
4027	\| ((label)? T_ENDFILE T_LPAREN) =>
4028	(label {lbl=$label.tk;})? T_ENDFILE T_LPAREN position_spec_list
4029	T_RPAREN end_of_stmt
4030	{action.endfile_stmt(lbl, $T_ENDFILE, null, $end_of_stmt.tk,
4031	true);}
4032	\| ((label)? T_END T_FILE) =>
4033	(label {lbl=$label.tk;})? T_END T_FILE file_unit_number end_of_stmt
4034	{action.endfile_stmt(lbl, $T_END, $T_FILE, $end_of_stmt.tk,
4035	false);}
4036	\| ((label)? T_ENDFILE) =>
4037	(label {lbl=$label.tk;})? T_ENDFILE file_unit_number end_of_stmt
4038	{action.endfile_stmt(lbl, $T_ENDFILE, null, $end_of_stmt.tk,
4039	false);}
4040	;
4041
4042	// R925
4043	rewind_stmt
4044	options {k=3;}
4045	@init {Token lbl = null;}
4046	@after{checkForInclude();}
4047	: ((label)? T_REWIND T_LPAREN) =>
4048	(label {lbl=$label.tk;})? T_REWIND T_LPAREN position_spec_list
4049	T_RPAREN end_of_stmt
4050	{action.rewind_stmt(lbl, $T_REWIND, $end_of_stmt.tk, true);}
4051	\| ((label)? T_REWIND) =>
4052	(label {lbl=$label.tk;})? T_REWIND file_unit_number end_of_stmt
4053	{action.rewind_stmt(lbl, $T_REWIND, $end_of_stmt.tk, false);}
4054	;
4055
4056	// R926
4057	// file_unit_number, scalar_int_variable, iomsg_variable, label replaced
4058	// by expr
4059	position_spec
4060	: expr
4061	{ action.position_spec(null); }
4062	\| T_IDENT /* {'UNIT','IOSTAT','IOMSG','ERR'} */ T_EQUALS expr
4063	{ action.position_spec($T_IDENT); }
4064	;
4065
4066	position_spec_list
4067	@init{ int count=0;}
4068	: {action.position_spec_list__begin();}
4069	position_spec {count++;} ( T_COMMA position_spec {count++;} )*
4070	{action.position_spec_list(count);}
4071	;
4072
4073	// R927
4074	flush_stmt
4075	options {k=3;}
4076	@init {Token lbl = null;}
4077	@after{checkForInclude();}
4078	: ((label)? T_FLUSH T_LPAREN) =>
4079	(label {lbl=$label.tk;})? T_FLUSH T_LPAREN flush_spec_list
4080	T_RPAREN end_of_stmt
4081	{action.flush_stmt(lbl, $T_FLUSH, $end_of_stmt.tk, true);}
4082	\| ((label)? T_FLUSH) =>
4083	(label {lbl=$label.tk;})? T_FLUSH file_unit_number end_of_stmt
4084	{action.flush_stmt(lbl, $T_FLUSH, $end_of_stmt.tk, false);}
4085	;
4086
4087	// R928
4088	// file_unit_number, scalar_int_variable, iomsg_variable, label replaced
4089	// by expr
4090	flush_spec
4091	: expr
4092	{ action.flush_spec(null); }
4093	\| T_IDENT /* {'UNIT','IOSTAT','IOMSG','ERR'} */ T_EQUALS expr
4094	{ action.flush_spec($T_IDENT); }
4095	;
4096
4097	flush_spec_list
4098	@init{ int count=0;}
4099	: {action.flush_spec_list__begin();}
4100	flush_spec {count++;} ( T_COMMA flush_spec {count++;} )*
4101	{action.flush_spec_list(count);}
4102	;
4103
4104	// R929
4105	inquire_stmt
4106	@init {Token lbl = null;}
4107	@after{checkForInclude();}
4108	: (label {lbl=$label.tk;})? T_INQUIRE T_LPAREN inquire_spec_list
4109	T_RPAREN end_of_stmt
4110	{action.inquire_stmt(lbl, $T_INQUIRE, null, $end_of_stmt.tk,
4111	false);}
4112	\| (label {lbl=$label.tk;})? T_INQUIRE_STMT_2
4113	T_INQUIRE T_LPAREN T_IDENT /* 'IOLENGTH' */ T_EQUALS
4114	scalar_int_variable T_RPAREN output_item_list end_of_stmt
4115	{action.inquire_stmt(lbl, $T_INQUIRE, $T_IDENT,
4116	$end_of_stmt.tk, true);}
4117	;
4118
4119
4120	// R930
4121	// ERR_CHK 930 file_name_expr replaced by expr
4122	// file_unit_number replaced by expr
4123	// scalar_default_char_variable replaced by designator
4124	inquire_spec
4125	: expr
4126	{ action.inquire_spec(null); }
4127	\| T_IDENT
4128	/* {'UNIT','FILE'} '=' expr portion, '=' designator portion below
4129	{'ACCESS','ACTION','ASYNCHRONOUS','BLANK','DECIMAL',DELIM','DIRECT'}
4130	{'ENCODING','ERR','EXIST','FORM','FORMATTED','ID','IOMSG','IOSTAT'}
4131	{'NAME','NAMED','NEXTREC','NUMBER',OPENED','PAD','PENDING','POS'}
4132	{'POSITION','READ','READWRITE','RECL','ROUND','SEQUENTIAL','SIGN'}
4133	{'SIZE','STREAM','UNFORMATTED','WRITE'} */
4134	T_EQUALS expr
4135	{ action.inquire_spec($T_IDENT); }
4136	;
4137
4138	inquire_spec_list
4139	@init{ int count=0;}
4140	: {action.inquire_spec_list__begin();}
4141	inquire_spec {count++;} ( T_COMMA inquire_spec {count++;} )*
4142	{action.inquire_spec_list(count);}
4143	;
4144
4145	/*
4146	Section 10:
4147	*/
4148
4149	// R1001
4150	// TODO: error checking: label is required. accept as optional so we can
4151	// report the error to the user.
4152	format_stmt
4153	@init {Token lbl = null;}
4154	@after{checkForInclude();}
4155	: (label {lbl=$label.tk;})? T_FORMAT format_specification end_of_stmt
4156	{action.format_stmt(lbl, $T_FORMAT, $end_of_stmt.tk);}
4157	;
4158
4159	// R1002
4160	format_specification
4161	@init{ boolean hasFormatItemList=false; }
4162	: T_LPAREN ( format_item_list {hasFormatItemList=true;})? T_RPAREN
4163	{action.format_specification(hasFormatItemList);}
4164	;
4165
4166	// R1003
4167	// r replaced by int_literal_constant replaced by char_literal_constant
4168	// replaced by T_CHAR_CONSTANT
4169	// char_string_edit_desc replaced by T_CHAR_CONSTANT
4170	format_item
4171	@init{ Token descOrDigit=null; boolean hasFormatItemList=false; }
4172	: T_DATA_EDIT_DESC
4173	{action.format_item($T_DATA_EDIT_DESC,hasFormatItemList);}
4174	\| T_CONTROL_EDIT_DESC
4175	{action.format_item($T_CONTROL_EDIT_DESC,hasFormatItemList);}
4176	\| T_CHAR_STRING_EDIT_DESC
4177	{action.format_item($T_CHAR_STRING_EDIT_DESC,hasFormatItemList);}
4178	\| (T_DIGIT_STRING {descOrDigit=$T_DIGIT_STRING;} )? T_LPAREN
4179	format_item_list T_RPAREN
4180	{action.format_item(descOrDigit,hasFormatItemList);}
4181	;
4182
4183	// the comma is not always required. see J3/04-007, pg. 221, lines
4184	// 17-22
4185	// ERR_CHK
4186	format_item_list
4187	@init{ int count=1;}
4188	: {action.format_item_list__begin();}
4189	format_item ( (T_COMMA)? format_item {count++;} )*
4190	{action.format_item_list(count);}
4191	;
4192
4193
4194	// the following rules, from here to the v_list, are the originals. modifying
4195	// to try and simplify and make match up with the standard.
4196	// original rules. 02.01.07
4197	// // R1003
4198	// // r replaced by int_literal_constant replaced by char_literal_constant replaced by T_CHAR_CONSTANT
4199	// // char_string_edit_desc replaced by T_CHAR_CONSTANT
4200	// format_item
4201	// : T_DIGIT_STRING data_edit_desc
4202	// \| data_plus_control_edit_desc
4203	// \| T_CHAR_CONSTANT
4204	// \| (T_DIGIT_STRING)? T_LPAREN format_item_list T_RPAREN
4205	// ;
4206
4207	// format_item_list
4208	// : format_item ( T_COMMA format_item )*
4209	// ;
4210
4211	// // R1004 r inlined in R1003 and R1011 as int_literal_constant (then as DIGIT_STRING)
4212	// // C1004 (R1004) r shall not have a kind parameter associated with it
4213
4214	// // R1005
4215	// // w,m,d,e replaced by int_literal_constant replaced by T_DIGIT_STRING
4216	// // char_literal_constant replaced by T_CHAR_CONSTANT
4217	// // ERR_CHK 1005 matching T_ID_OR_OTHER with alternatives will have to be done here
4218	// data_edit_desc
4219	// : T_ID_OR_OTHER /* {'I','B','O','Z','F','E','EN','ES','G','L','A','D'} */
4220	// T_DIGIT_STRING ( T_PERIOD T_DIGIT_STRING )?
4221	// ( T_ID_OR_OTHER /* is 'E' */ T_DIGIT_STRING )?
4222	// \| T_ID_OR_OTHER /* is 'DT' */ T_CHAR_CONSTANT ( T_LPAREN v_list T_RPAREN )?
4223	// \| T_ID_OR_OTHER /* {'A','DT'},{'X','P' from control_edit_desc} */
4224	// ;
4225
4226	// data_plus_control_edit_desc
4227	// : T_ID_OR_OTHER /* {'I','B','O','Z','F','E','EN','ES','G','L','A','D'},{T','TL','TR'} */
4228	// T_DIGIT_STRING ( T_PERIOD T_DIGIT_STRING )?
4229	// ( T_ID_OR_OTHER /* is 'E' */ T_DIGIT_STRING )?
4230	// \| T_ID_OR_OTHER /* is 'DT' */ T_CHAR_CONSTANT ( T_LPAREN v_list T_RPAREN )?
4231	// \| T_ID_OR_OTHER /* {'A','DT'},{'BN','BZ','RU','RD','RZ','RN','RC','RP','DC','DP'} */
4232	// // following only from control_edit_desc
4233	// \| ( T_DIGIT_STRING )? T_SLASH
4234	// \| T_COLON
4235	// \| (T_PLUS\|T_MINUS) T_DIGIT_STRING T_ID_OR_OTHER /* is 'P' */
4236	// ;
4237
4238	// R1006 w inlined in R1005 as int_literal_constant replaced by T_DIGIT_STRING
4239
4240	// R1007 m inlined in R1005 as int_literal_constant replaced by T_DIGIT_STRING
4241
4242	// R1008 d inlined in R1005 as int_literal_constant replaced by T_DIGIT_STRING
4243
4244	// R1009 e inlined in R1005 as int_literal_constant replaced by T_DIGIT_STRING
4245
4246	// R1010 v inlined as signed_int_literal_constant in v_list replaced by (T_PLUS or T_MINUS) T_DIGIT_STRING
4247
4248	v_list
4249	@init{int count=0;}
4250	: {action.v_list__begin();}
4251	(pm=T_PLUS\|T_MINUS)? ds=T_DIGIT_STRING
4252	{
4253	count++;
4254	action.v_list_part(pm, ds);
4255	}
4256	( T_COMMA (pm=T_PLUS\|T_MINUS)? ds=T_DIGIT_STRING
4257	{
4258	count++;
4259	action.v_list_part(pm, ds);
4260	}
4261	)*
4262	{action.v_list(count);}
4263	;
4264
4265	// R1011 control_edit_desc inlined/combined in R1005 and data_plus_control_edit_desc
4266	// r replaced by int_literal_constant replaced by T_DIGIT_STRING
4267	// k replaced by signed_int_literal_constant replaced by (T_PLUS\|T_MINUS)? T_DIGIT_STRING
4268	// position_edit_desc inlined
4269	// sign_edit_desc replaced by T_ID_OR_OTHER was {'SS','SP','S'}
4270	// blank_interp_edit_desc replaced by T_ID_OR_OTHER was {'BN','BZ'}
4271	// round_edit_desc replaced by T_ID_OR_OTHER was {'RU','RD','RZ','RN','RC','RP'}
4272	// decimal_edit_desc replaced by T_ID_OR_OTHER was {'DC','DP'}
4273	// leading T_ID_OR_OTHER alternates combined with data_edit_desc in data_plus_control_edit_desc
4274
4275	// R1012 k inlined in R1011 as signed_int_literal_constant
4276	// C1009 (R1012) k shall not have a kind parameter specified for it
4277
4278	// R1013 position_edit_desc inlined in R1011
4279	// n in R1013 was replaced by int_literal_constant replaced by T_DIGIT_STRING
4280
4281	// R1014 n inlined in R1013 as int_literal_constant (is T_DIGIT_STRING, see C1010)
4282	// C1010 (R1014) n shall not have a kind parameter specified for it
4283
4284	// R1015 sign_edit_desc inlined in R1011 as T_ID_OR_OTHER was {'SS','SP','S'}
4285
4286	// R1016 blank_interp_edit_desc inlined in R1011 as T_ID_OR_OTHER was {'BN','BZ'}
4287
4288	// R1017 round_edit_desc inlined in R1011 as T_ID_OR_OTHER was {'RU','RD','RZ','RN','RC','RP'}
4289
4290	// R1018 decimal_edit_desc inlined in R1011 as T_ID_OR_OTHER was {'DC','DP'}
4291
4292	// R1019 char_string_edit_desc was char_literal_constant inlined in R1003 as T_CHAR_CONSTANT
4293
4294	/*
4295	* Section 11:
4296	*/
4297
4298
4299	// R1102
4300	// T_IDENT inlined for program_name
4301	program_stmt
4302	@init {Token lbl = null;} // @init{INIT_TOKEN_NULL(lbl);}
4303	@after{checkForInclude();}
4304	: (label {lbl=$label.tk;})? T_PROGRAM T_IDENT end_of_stmt
4305	{ action.program_stmt(lbl, $T_PROGRAM, $T_IDENT, $end_of_stmt.tk); }
4306	;
4307
4308	// R1103
4309	// T_IDENT inlined for program_name
4310	end_program_stmt
4311	@init {Token lbl = null; Token id = null;}
4312	@after {checkForInclude();}
4313	: (label {lbl=$label.tk;})? T_END T_PROGRAM (T_IDENT {id=$T_IDENT;})?
4314	end_of_stmt
4315	{ action.end_program_stmt(lbl, $T_END, $T_PROGRAM, id,
4316	$end_of_stmt.tk); }
4317	\| (label {lbl=$label.tk;})? T_ENDPROGRAM (T_IDENT {id=$T_IDENT;})?
4318	end_of_stmt
4319	{ action.end_program_stmt(lbl, $T_ENDPROGRAM, null, id,
4320	$end_of_stmt.tk); }
4321	\| (label {lbl=$label.tk;})? T_END end_of_stmt
4322	{ action.end_program_stmt(lbl, $T_END, null, null,
4323	$end_of_stmt.tk); }
4324	;
4325
4326
4327	// R1104
4328	// C1104 (R1104) A module specification-part shall not contain a
4329	// stmt-function-stmt, an entry-stmt or a format-stmt
4330	// specification_part made non-optional to remove END ambiguity (as can
4331	// be empty)
4332	module
4333	@after {
4334	action.module();
4335	}
4336	: module_stmt
4337	specification_part
4338	( module_subprogram_part )?
4339	end_module_stmt
4340	;
4341
4342	// R1105
4343	module_stmt
4344	@init {Token lbl = null; Token id = null;}
4345	@after{checkForInclude();}
4346	: {action.module_stmt__begin();}
4347	(label {lbl=$label.tk;})? T_MODULE ( T_IDENT {id=$T_IDENT;} )?
4348	end_of_stmt
4349	{action.module_stmt(lbl, $T_MODULE, id, $end_of_stmt.tk);}
4350	;
4351
4352
4353	// R1106
4354	end_module_stmt
4355	@init {Token lbl = null; Token id = null;}
4356	@after{checkForInclude();}
4357	: (label {lbl=$label.tk;})? T_END T_MODULE (T_IDENT {id=$T_IDENT;})?
4358	end_of_stmt
4359	{action.end_module_stmt(lbl, $T_END, $T_MODULE, id,
4360	$end_of_stmt.tk);}
4361	\| (label {lbl=$label.tk;})? T_ENDMODULE (T_IDENT {id=$T_IDENT;})?
4362	end_of_stmt
4363	{action.end_module_stmt(lbl, $T_ENDMODULE, null, id,
4364	$end_of_stmt.tk);}
4365	\| (label {lbl=$label.tk;})? T_END end_of_stmt
4366	{action.end_module_stmt(lbl, $T_END, null, id, $end_of_stmt.tk);}
4367	;
4368
4369	////////////
4370	// R1107-F03
4371	//
4372	module_subprogram_part
4373	@init {int count = 1;}
4374	: contains_stmt
4375	module_subprogram
4376	( module_subprogram {count += 1;} )*
4377	{ action.module_subprogram_part(count); }
4378	;
4379
4380	// R1108
4381	// modified to factor optional prefix
4382	module_subprogram
4383	@init{boolean hasPrefix = false;}
4384	: (prefix {hasPrefix=true;})? function_subprogram
4385	{action.module_subprogram(hasPrefix);}
4386	\| subroutine_subprogram
4387	{action.module_subprogram(hasPrefix);}
4388	;
4389
4390	// R1109
4391	use_stmt
4392	@init {
4393	Token lbl=null;
4394	boolean hasModuleNature=false;
4395	boolean hasRenameList=false;
4396	}
4397	@after{checkForInclude();}
4398	: (label {lbl=$label.tk;})? T_USE
4399	( (T_COMMA module_nature {hasModuleNature=true;})?
4400	T_COLON_COLON )? T_IDENT ( T_COMMA
4401	rename_list {hasRenameList=true;})? end_of_stmt
4402	{action.use_stmt(lbl, $T_USE, $T_IDENT, null, $end_of_stmt.tk,
4403	hasModuleNature, hasRenameList, false);}
4404	\| (label {lbl=$label.tk;})? T_USE
4405	( ( T_COMMA module_nature {hasModuleNature=true;})?
4406	T_COLON_COLON )? T_IDENT T_COMMA T_ONLY T_COLON ( only_list )?
4407	end_of_stmt
4408	{action.use_stmt(lbl, $T_USE, $T_IDENT, $T_ONLY, $end_of_stmt.tk,
4409	hasModuleNature,hasRenameList,true);}
4410	;
4411
4412	// R1110
4413	module_nature
4414	: T_INTRINSIC
4415	{ action.module_nature($T_INTRINSIC); }
4416	\| T_NON_INTRINSIC
4417	{ action.module_nature($T_NON_INTRINSIC); }
4418	;
4419
4420	// R1111
4421	// T_DEFINED_OP inlined for local_defined_operator and use_defined_operator
4422	// T_IDENT inlined for local_name and use_name
4423	rename
4424	: id1=T_IDENT T_EQ_GT id2=T_IDENT
4425	{ action.rename(id1, id2, null, null, null, null); }
4426	\| op1=T_OPERATOR T_LPAREN defOp1=T_DEFINED_OP T_RPAREN T_EQ_GT
4427	op2=T_OPERATOR T_LPAREN defOp2=T_DEFINED_OP T_RPAREN
4428	{ action.rename(null, null, op1, defOp1, op2, defOp2); }
4429	;
4430
4431	rename_list
4432	@init{ int count=0;}
4433	: {action.rename_list__begin();}
4434	rename {count++;} ( T_COMMA rename {count++;} )*
4435	{action.rename_list(count);}
4436	;
4437
4438	// R1112
4439	// T_IDENT inlined for only_use_name
4440	// generic_spec can be T_IDENT so T_IDENT deleted
4441	only
4442	@init{ boolean hasGenericSpec=false;
4443	boolean hasRename=false;
4444	boolean hasOnlyUseName=false;}
4445	@after {
4446	action.only(hasGenericSpec, hasRename, hasOnlyUseName);
4447	}
4448	: generic_spec {hasGenericSpec=true;}
4449	\| rename {hasRename=true;}
4450	;
4451
4452	only_list
4453	@init{ int count=0;}
4454	: {action.only_list__begin();}
4455	only {count++;} ( T_COMMA only {count++;} )*
4456	{action.only_list(count);}
4457	;
4458
4459	// R1113 only_use_name was use_name inlined as T_IDENT
4460
4461	// R1114 inlined local_defined_operator in R1111 as T_DEFINED_OP
4462
4463	// R1115 inlined use_defined_operator in R1111 as T_DEFINED_OP
4464
4465	// R1116
4466	// specification_part made non-optional to remove END ambiguity (as can
4467	// be empty).
4468	block_data
4469	@after {
4470	action.block_data();
4471	}
4472	: block_data_stmt
4473	specification_part
4474	end_block_data_stmt
4475	;
4476
4477	// R1117
4478	block_data_stmt
4479	@init
4480	{
4481	Token lbl = null; Token id = null;
4482	action.block_data_stmt__begin();
4483	}
4484	@after{checkForInclude();}
4485	: (label {lbl=$label.tk;})?
4486	T_BLOCK T_DATA (T_IDENT {id=$T_IDENT;})? end_of_stmt
4487	{action.block_data_stmt(lbl, $T_BLOCK, $T_DATA, id, $end_of_stmt.tk);}
4488	\| (label {lbl=$label.tk;})?
4489	T_BLOCKDATA (T_IDENT {id=$T_IDENT;})? end_of_stmt
4490	{action.block_data_stmt(lbl, $T_BLOCKDATA, null, id, $end_of_stmt.tk);}
4491	;
4492
4493	// R1118
4494	end_block_data_stmt
4495	@init {Token lbl = null; Token id = null;}
4496	@after{checkForInclude();}
4497	: (label {lbl=$label.tk;})? T_END T_BLOCK T_DATA
4498	( T_IDENT {id=$T_IDENT;})? end_of_stmt
4499	{action.end_block_data_stmt(lbl, $T_END, $T_BLOCK, $T_DATA, id,
4500	$end_of_stmt.tk);}
4501	\| (label {lbl=$label.tk;})? T_ENDBLOCK T_DATA
4502	( T_IDENT {id=$T_IDENT;})? end_of_stmt
4503	{action.end_block_data_stmt(lbl, $T_ENDBLOCK, null, $T_DATA, id,
4504	$end_of_stmt.tk);}
4505	\| (label {lbl=$label.tk;})? T_END T_BLOCKDATA
4506	( T_IDENT {id=$T_IDENT;})? end_of_stmt
4507	{action.end_block_data_stmt(lbl, $T_END, $T_BLOCKDATA, null, id,
4508	$end_of_stmt.tk);}
4509	\| (label {lbl=$label.tk;})? T_ENDBLOCKDATA
4510	( T_IDENT {id=$T_IDENT;})? end_of_stmt
4511	{action.end_block_data_stmt(lbl, $T_ENDBLOCKDATA, null, null, id,
4512	$end_of_stmt.tk);}
4513	\| (label {lbl=$label.tk;})? T_END end_of_stmt
4514	{action.end_block_data_stmt(lbl, $T_END, null, null, id,
4515	$end_of_stmt.tk);}
4516	;
4517
4518	/*
4519	* Section 12:
4520	*/
4521
4522	// R1201
4523	interface_block
4524	@after {
4525	action.interface_block();
4526	}
4527	: interface_stmt
4528	( interface_specification )*
4529	end_interface_stmt
4530	;
4531
4532	// R1202
4533	interface_specification
4534	@after {
4535	action.interface_specification();
4536	}
4537	: interface_body
4538	\| procedure_stmt
4539	;
4540
4541	// R1203 Note that the last argument to the action specifies whether this
4542	// is an abstract interface or not.
4543	interface_stmt
4544	@init {Token lbl = null; boolean hasGenericSpec=false;}
4545	@after{checkForInclude();}
4546	: {action.interface_stmt__begin();}
4547	(label {lbl=$label.tk;})? T_INTERFACE ( generic_spec
4548	{hasGenericSpec=true;})? end_of_stmt
4549	{action.interface_stmt(lbl, null, $T_INTERFACE, $end_of_stmt.tk,
4550	hasGenericSpec);}
4551	\| (label {lbl=$label.tk;})? T_ABSTRACT T_INTERFACE end_of_stmt
4552	{action.interface_stmt(lbl, $T_ABSTRACT, $T_INTERFACE,
4553	$end_of_stmt.tk, hasGenericSpec);}
4554	;
4555
4556	// R1204
4557	end_interface_stmt
4558	@init {Token lbl = null; boolean hasGenericSpec=false;}
4559	@after{checkForInclude();}
4560	: (label {lbl=$label.tk;})? T_END T_INTERFACE ( generic_spec
4561	{hasGenericSpec=true;})? end_of_stmt
4562	{action.end_interface_stmt(lbl, $T_END, $T_INTERFACE,
4563	$end_of_stmt.tk, hasGenericSpec);}
4564	\| (label {lbl=$label.tk;})? T_ENDINTERFACE ( generic_spec
4565	{hasGenericSpec=true;})? end_of_stmt
4566	{action.end_interface_stmt(lbl, $T_ENDINTERFACE, null,
4567	$end_of_stmt.tk, hasGenericSpec);}
4568	;
4569
4570	// R1205
4571	// specification_part made non-optional to remove END ambiguity (as can
4572	// be empty)
4573	interface_body
4574	: (prefix)? function_stmt specification_part end_function_stmt
4575	{ action.interface_body(true); /* true for hasPrefix */ }
4576	\| subroutine_stmt specification_part end_subroutine_stmt
4577	{ action.interface_body(false); /* false for hasPrefix */ }
4578	;
4579
4580	// R1206
4581	// generic_name_list substituted for procedure_name_list
4582	procedure_stmt
4583	@init {Token lbl = null; Token module=null;}
4584	@after{checkForInclude();}
4585	: (label {lbl=$label.tk;})? ( T_MODULE {module=$T_MODULE;})?
4586	T_PROCEDURE generic_name_list end_of_stmt
4587	{action.procedure_stmt(lbl, module, $T_PROCEDURE,
4588	$end_of_stmt.tk);}
4589	;
4590
4591	// R1207
4592	// T_IDENT inlined for generic_name
4593	generic_spec
4594	: T_IDENT
4595	{action.generic_spec(null, $T_IDENT,
4596	IActionEnums.GenericSpec_generic_name);}
4597	\| T_OPERATOR T_LPAREN defined_operator T_RPAREN
4598	{action.generic_spec($T_OPERATOR, null,
4599	IActionEnums.GenericSpec_OPERATOR);}
4600	\| T_ASSIGNMENT T_LPAREN T_EQUALS T_RPAREN
4601	{action.generic_spec($T_ASSIGNMENT, null,
4602	IActionEnums.GenericSpec_ASSIGNMENT);}
4603	\| dtio_generic_spec
4604	{ action.generic_spec(null, null,
4605	IActionEnums.GenericSpec_dtio_generic_spec); }
4606	;
4607
4608	// R1208
4609	dtio_generic_spec
4610	: T_READ T_LPAREN T_FORMATTED T_RPAREN
4611	{action.dtio_generic_spec($T_READ, $T_FORMATTED,
4612	IActionEnums.
4613	DTIOGenericSpec_READ_FORMATTED);}
4614	\| T_READ T_LPAREN T_UNFORMATTED T_RPAREN
4615	{action.dtio_generic_spec($T_READ, $T_UNFORMATTED,
4616	IActionEnums.
4617	DTIOGenericSpec_READ_UNFORMATTED);}
4618	\| T_WRITE T_LPAREN T_FORMATTED T_RPAREN
4619	{action.dtio_generic_spec($T_WRITE, $T_FORMATTED,
4620	IActionEnums.
4621	DTIOGenericSpec_WRITE_FORMATTED);}
4622	\| T_WRITE T_LPAREN T_UNFORMATTED T_RPAREN
4623	{action.dtio_generic_spec($T_WRITE, $T_UNFORMATTED,
4624	IActionEnums.
4625	DTIOGenericSpec_WRITE_UNFORMATTED);}
4626	;
4627
4628	// R1209
4629	// generic_name_list substituted for import_name_list
4630	import_stmt
4631	@init {Token lbl = null; boolean hasGenericNameList=false;}
4632	@after{checkForInclude();}
4633	: (label {lbl=$label.tk;})? T_IMPORT ( ( T_COLON_COLON )?
4634	generic_name_list {hasGenericNameList=true;})? end_of_stmt
4635	{action.import_stmt(lbl, $T_IMPORT, $end_of_stmt.tk,
4636	hasGenericNameList);}
4637	;
4638
4639	// R1210
4640	// generic_name_list substituted for external_name_list
4641	external_stmt
4642	@init {Token lbl = null;} // @init{INIT_TOKEN_NULL(lbl);}
4643	@after{checkForInclude();}
4644	: (label {lbl=$label.tk;})? T_EXTERNAL ( T_COLON_COLON )?
4645	generic_name_list end_of_stmt
4646	{action.external_stmt(lbl, $T_EXTERNAL, $end_of_stmt.tk);}
4647	;
4648
4649	// R1211
4650	procedure_declaration_stmt
4651	@init {Token lbl = null; boolean hasProcInterface=false; int count=0;}
4652	@after{checkForInclude();}
4653	: (label {lbl=$label.tk;})? T_PROCEDURE T_LPAREN
4654	( proc_interface {hasProcInterface=true;})? T_RPAREN
4655	( ( T_COMMA proc_attr_spec {count++;})* T_COLON_COLON )?
4656	proc_decl_list end_of_stmt
4657	{action.procedure_declaration_stmt(lbl, $T_PROCEDURE,
4658	$end_of_stmt.tk, hasProcInterface, count);}
4659	;
4660
4661	// R1212
4662	// T_IDENT inlined for interface_name
4663	proc_interface
4664	: T_IDENT { action.proc_interface($T_IDENT); }
4665	\| declaration_type_spec { action.proc_interface(null); }
4666	;
4667
4668	// R1213
4669	proc_attr_spec
4670	: access_spec
4671	{ action.proc_attr_spec(null, null, IActionEnums.AttrSpec_none); }
4672	\| proc_language_binding_spec
4673	{ action.proc_attr_spec(null, null, IActionEnums.AttrSpec_none); }
4674	\| T_INTENT T_LPAREN intent_spec T_RPAREN
4675	{ action.proc_attr_spec($T_INTENT, null,
4676	IActionEnums.AttrSpec_INTENT); }
4677	\| T_OPTIONAL
4678	{ action.proc_attr_spec($T_OPTIONAL, null,
4679	IActionEnums.AttrSpec_OPTIONAL); }
4680	\| T_POINTER
4681	{ action.proc_attr_spec($T_POINTER, null,
4682	IActionEnums.AttrSpec_POINTER); }
4683	\| T_SAVE
4684	{ action.proc_attr_spec($T_SAVE, null,
4685	IActionEnums.AttrSpec_SAVE); }
4686	// TODO: are T_PASS, T_NOPASS, and T_DEFERRED correct?
4687	// From R453 binding-attr
4688	\| T_PASS ( T_LPAREN T_IDENT T_RPAREN)?
4689	{ action.proc_attr_spec($T_PASS, $T_IDENT,
4690	IActionEnums.AttrSpec_PASS); }
4691	\| T_NOPASS
4692	{ action.proc_attr_spec($T_NOPASS, null,
4693	IActionEnums.AttrSpec_NOPASS); }
4694	\| T_DEFERRED
4695	{ action.proc_attr_spec($T_DEFERRED, null,
4696	IActionEnums.AttrSpec_DEFERRED); }
4697	;
4698
4699	// R1214
4700	// T_IDENT inlined for procedure_entity_name
4701	proc_decl
4702	@init{boolean hasNullInit = false;}
4703	: T_IDENT ( T_EQ_GT null_init {hasNullInit=true;} )?
4704	{ action.proc_decl($T_IDENT, hasNullInit); }
4705	;
4706
4707	proc_decl_list
4708	@init{ int count=0;}
4709	: {action.proc_decl_list__begin();}
4710	proc_decl {count++;} ( T_COMMA proc_decl {count++;} )*
4711	{action.proc_decl_list(count);}
4712	;
4713
4714	// R1215 interface_name was name inlined as T_IDENT
4715
4716	// R1216
4717	// generic_name_list substituted for intrinsic_procedure_name_list
4718	intrinsic_stmt
4719	@init {Token lbl = null;}
4720	@after{checkForInclude();}
4721	: (label {lbl=$label.tk;})? T_INTRINSIC
4722	( T_COLON_COLON )?
4723	generic_name_list end_of_stmt
4724	{action.intrinsic_stmt(lbl, $T_INTRINSIC, $end_of_stmt.tk);}
4725	;
4726
4727	// R1217 function_reference replaced by designator_or_func_ref to reduce
4728	// backtracking
4729
4730	// R1218
4731	// C1222 (R1218) The procedure-designator shall designate a subroutine.
4732	call_stmt
4733	@init {Token lbl = null; boolean hasActualArgSpecList = false;}
4734	@after{checkForInclude();}
4735	: (label {lbl=$label.tk;})? T_CALL procedure_designator
4736	( T_LPAREN (actual_arg_spec_list {hasActualArgSpecList=true;})?
4737	T_RPAREN )? end_of_stmt
4738	{ action.call_stmt(lbl, $T_CALL, $end_of_stmt.tk,
4739	hasActualArgSpecList); }
4740	;
4741
4742	// R1219
4743	// ERR_CHK 1219 must be (T_IDENT \| designator T_PERCENT T_IDENT)
4744	// T_IDENT inlined for procedure_name and binding_name
4745	// proc_component_ref is variable T_PERCENT T_IDENT (variable is designator)
4746	// data_ref subset of designator so data_ref T_PERCENT T_IDENT deleted
4747	// designator (R603), minus the substring part is data_ref, so designator
4748	// replaced by data_ref
4749	//R1219 procedure-designator is procedure-name
4750	// or proc-component-ref
4751	// or data-ref % binding-name
4752	procedure_designator
4753	: data_ref
4754	{ action.procedure_designator(); }
4755	;
4756
4757	// R1220
4758	actual_arg_spec
4759	@init{Token keyword = null;}
4760	: (T_IDENT T_EQUALS {keyword=$T_IDENT;})? actual_arg
4761	{ action.actual_arg_spec(keyword); }
4762	;
4763
4764	// TODO - delete greedy?
4765	actual_arg_spec_list
4766	options{greedy=false;}
4767	@init{int count = 0;}
4768	: { action.actual_arg_spec_list__begin(); }
4769	actual_arg_spec {count++;} ( T_COMMA actual_arg_spec {count++;} )*
4770	{ action.actual_arg_spec_list(count); }
4771	;
4772
4773	// R1221
4774	// ERR_CHK 1221 ensure ( expr \| designator ending in T_PERCENT T_IDENT)
4775	// T_IDENT inlined for procedure_name
4776	// expr isa designator (via primary) so variable deleted
4777	// designator isa T_IDENT so T_IDENT deleted
4778	// proc_component_ref is variable T_PERCENT T_IDENT can be designator so
4779	// deleted
4780	actual_arg
4781	@init{boolean hasExpr = false;}
4782	: expr
4783	{ hasExpr=true; action.actual_arg(hasExpr, null); }
4784	\| T_ASTERISK label
4785	{ action.actual_arg(hasExpr, $label.tk); }
4786	;
4787
4788	// R1222 alt_return_spec inlined as T_ASTERISK label in R1221
4789
4790	// R1223
4791	// 1. left factored optional prefix in function_stmt from function_subprogram
4792	// 2. specification_part made non-optional to remove END ambiguity (as can
4793	// be empty)
4794	function_subprogram
4795	@init {
4796	boolean hasExePart = false;
4797	boolean hasIntSubProg = false;
4798	}
4799	: function_stmt
4800	specification_part
4801	( execution_part { hasExePart=true; })?
4802	( internal_subprogram_part { hasIntSubProg=true; })?
4803	end_function_stmt
4804	{ action.function_subprogram(hasExePart, hasIntSubProg); }
4805	;
4806
4807	// R1224
4808	// left factored optional prefix from function_stmt
4809	// generic_name_list substituted for dummy_arg_name_list
4810	function_stmt
4811	@init {
4812	Token lbl = null;
4813	boolean hasGenericNameList=false;
4814	boolean hasSuffix=false;
4815	}
4816	@after{checkForInclude();}
4817	: {action.function_stmt__begin();}
4818	(label {lbl=$label.tk;})? T_FUNCTION T_IDENT
4819	T_LPAREN ( generic_name_list {hasGenericNameList=true;})? T_RPAREN
4820	( suffix {hasSuffix=true;})? end_of_stmt
4821	{action.function_stmt(lbl, $T_FUNCTION, $T_IDENT, $end_of_stmt.tk,
4822	hasGenericNameList,hasSuffix);}
4823	;
4824
4825	// R1225
4826	proc_language_binding_spec
4827	: language_binding_spec
4828	{ action.proc_language_binding_spec(); }
4829	;
4830
4831	// R1226 dummy_arg_name was name inlined as T_IDENT
4832
4833	// R1227
4834	// C1240 (R1227) A prefix shall contain at most one of each prefix-spec
4835	// C1241 (R1227) A prefix shall not specify both ELEMENTAL AND RECURSIVE
4836	prefix
4837	@init{int specCount=1;}
4838	: prefix_spec ( prefix_spec{specCount++;}
4839	(prefix_spec{specCount++;} )? )?
4840	{action.prefix(specCount);}
4841	;
4842
4843	t_prefix
4844	@init{int specCount=1;}
4845	: t_prefix_spec ( t_prefix_spec {specCount++;})?
4846	{action.t_prefix(specCount);}
4847	;
4848
4849	// R1228
4850	prefix_spec
4851	: declaration_type_spec
4852	{action.prefix_spec(true);}
4853	\| t_prefix_spec
4854	{action.prefix_spec(false);}
4855	;
4856
4857	t_prefix_spec
4858	: T_RECURSIVE {action.t_prefix_spec($T_RECURSIVE);}
4859	\| T_PURE {action.t_prefix_spec($T_PURE);}
4860	\| T_ELEMENTAL {action.t_prefix_spec($T_ELEMENTAL);}
4861	;
4862
4863	// R1229
4864	suffix
4865	@init {
4866	Token result = null;
4867	boolean hasProcLangBindSpec = false;
4868	}
4869	: proc_language_binding_spec ( T_RESULT T_LPAREN result_name
4870	T_RPAREN { result=$T_RESULT; })?
4871	{ action.suffix(result, true); }
4872	\| T_RESULT T_LPAREN result_name T_RPAREN
4873	( proc_language_binding_spec { hasProcLangBindSpec = true; })?
4874	{ action.suffix($T_RESULT, hasProcLangBindSpec); }
4875	;
4876
4877	result_name
4878	: name
4879	{ action.result_name(); }
4880	;
4881
4882	// R1230
4883	end_function_stmt
4884	@init {Token lbl = null; Token id = null;}
4885	@after{checkForInclude();}
4886	: (label {lbl=$label.tk;})? T_END T_FUNCTION ( T_IDENT {id=$T_IDENT;})?
4887	end_of_stmt
4888	{action.end_function_stmt(lbl, $T_END, $T_FUNCTION, id,
4889	$end_of_stmt.tk);}
4890	\| (label {lbl=$label.tk;})? T_ENDFUNCTION ( T_IDENT {id=$T_IDENT;})?
4891	end_of_stmt
4892	{action.end_function_stmt(lbl, $T_ENDFUNCTION, null, id,
4893	$end_of_stmt.tk);}
4894	\| (label {lbl=$label.tk;})? T_END end_of_stmt
4895	{action.end_function_stmt(lbl, $T_END, null, id, $end_of_stmt.tk);}
4896	;
4897
4898	// R1231
4899	// specification_part made non-optional to remove END ambiguity (as can
4900	// be empty)
4901	subroutine_subprogram
4902	: subroutine_stmt
4903	specification_part
4904	( execution_part )?
4905	( internal_subprogram_part )?
4906	end_subroutine_stmt
4907	;
4908
4909	// R1232
4910	subroutine_stmt
4911	@init {Token lbl = null; boolean hasPrefix=false;
4912	boolean hasDummyArgList=false;
4913	boolean hasBindingSpec=false;
4914	boolean hasArgSpecifier=false;}
4915	@after{checkForInclude();}
4916	: {action.subroutine_stmt__begin();}
4917	(label {lbl=$label.tk;})? (t_prefix {hasPrefix=true;})? T_SUBROUTINE
4918	T_IDENT ( T_LPAREN ( dummy_arg_list {hasDummyArgList=true;})?
4919	T_RPAREN ( proc_language_binding_spec {hasBindingSpec=true;})?
4920	{hasArgSpecifier=true;})? end_of_stmt
4921	{action.subroutine_stmt(lbl, $T_SUBROUTINE, $T_IDENT,
4922	$end_of_stmt.tk,
4923	hasPrefix, hasDummyArgList,
4924	hasBindingSpec, hasArgSpecifier);}
4925	;
4926
4927	// R1233
4928	// T_IDENT inlined for dummy_arg_name
4929	dummy_arg
4930	options{greedy=false; memoize=false;}
4931	: T_IDENT { action.dummy_arg($T_IDENT); }
4932	\| T_ASTERISK { action.dummy_arg($T_ASTERISK); }
4933	;
4934
4935	dummy_arg_list
4936	@init{ int count=0;}
4937	: {action.dummy_arg_list__begin();}
4938	dummy_arg {count++;} ( T_COMMA dummy_arg {count++;} )*
4939	{action.dummy_arg_list(count);}
4940	;
4941
4942	// R1234
4943	end_subroutine_stmt
4944	@init {Token lbl = null; Token id=null;}
4945	@after{checkForInclude();}
4946	: (label {lbl=$label.tk;})? T_END T_SUBROUTINE ( T_IDENT {id=$T_IDENT;})?
4947	end_of_stmt
4948	{action.end_subroutine_stmt(lbl, $T_END, $T_SUBROUTINE, id,
4949	$end_of_stmt.tk);}
4950	\| (label {lbl=$label.tk;})? T_ENDSUBROUTINE ( T_IDENT {id=$T_IDENT;})?
4951	end_of_stmt
4952	{action.end_subroutine_stmt(lbl, $T_ENDSUBROUTINE, null, id,
4953	$end_of_stmt.tk);}
4954	\| (label {lbl=$label.tk;})? T_END end_of_stmt
4955	{action.end_subroutine_stmt(lbl, $T_END, null, id, $end_of_stmt.tk);}
4956	;
4957
4958	// R1235
4959	// T_INDENT inlined for entry_name
4960	entry_stmt
4961	@init {
4962	Token lbl = null;
4963	boolean hasDummyArgList=false;
4964	boolean hasSuffix=false;
4965	}
4966	@after{checkForInclude();}
4967	: (label {lbl=$label.tk;})? T_ENTRY T_IDENT
4968	( T_LPAREN ( dummy_arg_list {hasDummyArgList=true;} )? T_RPAREN
4969	( suffix {hasSuffix=true;})? )? end_of_stmt
4970	{action.entry_stmt(lbl, $T_ENTRY, $T_IDENT, $end_of_stmt.tk,
4971	hasDummyArgList, hasSuffix);}
4972	;
4973
4974	// R1236
4975	// ERR_CHK 1236 scalar_int_expr replaced by expr
4976	return_stmt
4977	@init {Token lbl = null; boolean hasScalarIntExpr=false;}
4978	@after{checkForInclude();}
4979	: (label {lbl=$label.tk;})? T_RETURN ( expr {hasScalarIntExpr=true;})?
4980	end_of_stmt
4981	{action.return_stmt(lbl, $T_RETURN, $end_of_stmt.tk,
4982	hasScalarIntExpr);}
4983	;
4984
4985	// R1237
4986	contains_stmt
4987	@init {Token lbl = null;}
4988	@after{checkForInclude();}
4989	: (label {lbl=$label.tk;})? T_CONTAINS end_of_stmt
4990	{action.contains_stmt(lbl, $T_CONTAINS, $end_of_stmt.tk);}
4991	;
4992
4993
4994	// R1238
4995	// ERR_CHK 1239 scalar_expr replaced by expr
4996	// generic_name_list substituted for dummy_arg_name_list
4997	// TODO Hopefully scanner and parser can help work together here to work
4998	// around ambiguity.
4999	// why can't this be accepted as an assignment statement and then the parser
5000	// look up the symbol for the T_IDENT to see if it is a function??
5001	// Need scanner to send special token if it sees what?
5002	// TODO - won't do a(b==3,c) = 2
5003	stmt_function_stmt
5004	@init {Token lbl = null; boolean hasGenericNameList=false;}
5005	@after{checkForInclude();}
5006	: (label {lbl=$label.tk;})? T_STMT_FUNCTION T_IDENT T_LPAREN
5007	( generic_name_list {hasGenericNameList=true;})? T_RPAREN
5008	T_EQUALS expr end_of_stmt
5009	{action.stmt_function_stmt(lbl, $T_IDENT, $end_of_stmt.tk,
5010	hasGenericNameList);}
5011	;
5012
5013	// added this to have a way to match the T_EOS and EOF combinations
5014	end_of_stmt returns [Token tk]
5015	: T_EOS
5016	{
5017	CivlcToken eos = (CivlcToken)$T_EOS;
5018	tk = $T_EOS;
5019	action.end_of_stmt($T_EOS);
5020	}
5021	// the (EOF) => EOF is done with lookahead because if it's not there,
5022	// then antlr will crash with an internal error while trying to
5023	// generate the java code. (as of 12.11.06)
5024	// not sure this is ever reached
5025	\| (EOF) => EOF
5026	{
5027	tk = $EOF; action.end_of_stmt($EOF);
5028	action.end_of_file(filename);
5029	}
5030	;

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format