%|
 | FORTRAN.BNF
 |
 | Parser for FORVER version 2.6
 |%

addop	= "+" |	"-"				% adding operators %.
mulop	= "*" |	"/"				% multiplying operators	%.
relop	= "<" |	"<=" | "==" | "=/=" | ">=" | ">" % relational operators	%.

sign	= "+" |	"-"				% signs	%.

simple_type	= integer | real | complex | logical.

constant	= integer_constant
		| real_constant
		| boolean_constant
		| double_constant
		| string_constant
		| hollerith_constant
		| label_constant.
char_string	= string_constant | hollerith_constant.
integer_item	= identifier  |	integer_constant.
id		= identifier  |	array_identifier.
idx		= identifier
		| array_identifier
		| function_identifier
		| intrinsic_identifier.
except		= identifier  |	array_identifier | end.

	% now the productions for the FORTRAN grammar %
	%    start symbol:     f10_program	      %

f10_program	-> [ line ] end_file <verify>.

line		->			      end_line <xon> @ % null statement	%
		 | integer_constant statement end_line <xon> @ % labeled statement %
		 |		    statement end_line <xon> @ % unlabeled statement %.

statement	-> assignment_statement
		 | control_statement
		 | io_statement
		 | file_control_statement
		 | format_statement

		 | definition_statement
		 | data_statement

		 | namelist_statement
		 | device_control_statement.

definition_statement ->
		   PROGRAM' <xoff> identifier'	<xmodule> <xreset>
		 | INCLUDE <xx>	char_string	<xinclude>

		 | END <xend>

		 | DIMENSION <xx>     idx' <- identifier <xlocal> index_spec
				[ "," idx' <- identifier <xlocal> index_spec ]
		 | IMPLICIT   type_id <xx> "(" letter_list ")" <xon> <ximplicit>
			[ "," type_id <xx> "(" letter_list ")" <xon> <ximplicit> ]
		 | COMMON <xx>	( "/" idx "/" common_spec [ "/"	idx "/"	common_spec ]
				|     nil     common_spec )
		 | EQUIVALENCE <xx> "("	index_use ")" [	"," "("	index_use ")" ]

		 | EXTERNAL <xx> identifier' <xexternal> [ "," identifier' <xexternal> ]
		 | PARAMETER <xx> identifier' "=" (sign|nil) constant' <xparameter>
			    [ "," identifier' "=" (sign|nil) constant' <xparameter> ]
		 | type_id ( FUNCTION' <xoff> identifier' <xmodule> <xentry>
					  ( "("	dummies	")" | nil ) <xedum>
			   | nil <xx> <xtyp> idx' <xstyp> index_spec [ "," idx'	<xstyp>	index_spec ]
			   )
		 | FUNCTION' nil' <xswap> <xoff> identifier' <xmodule> <xentry>
				   ( "(" dummies ")" | nil ) <xedum>
		 | SUBROUTINE'		  <xoff> identifier' <xmodule> <xentry>
				   ( "(" dummies ")" | nil ) <xedum>
		 | ENTRY'		  <xoff> identifier'	       <xentry>
				   ( "(" dummies ")" | nil ) <xedum>
		 | BLOCK' DATA		<xoff> ( identifier' | nil' ) <xmodule>	<xreset>.



data_statement	-> DATA	<xx>   data_list "/" data_constant_list	"/"
			 [ "," data_list "/" data_constant_list	"/" ].

assignment_statement ->
		   local_indexed_identifier "="	expression <xassign>
		 | ASSIGN <xx> <xon> integer_constant' TO <xoff> id' <xswap> <xassign>.

control_statement ->
		   (GO TO | GOTO) <xx>
			( integer_constant
			| "(" integer_list ")" ("," | nil) expression <xreset>
			| identifier "," "(" integer_list ")" )
		 | IF <xx> "(" expression ")" <xon> <xreset>
			( integer_constant "," integer_constant
					 ( "," integer_constant
					 |	nil )
			| statement )
		 | DO	<xx> integer_constant
						  identifier
					 "=" expression
					 "," expression
				       ( "," expression	| nil )	<xreset>
		 | CONTINUE <xx>
		 | STOP	<xx>	( integer_constant
				| char_string
				| nil )
		 | PAUSE <xx>	( integer_constant
				| char_string
				| nil )
		 | RETURN <xx>	( integer_constant
				| nil )
		 | CALL	<xx> identifier' [ identifier ]
			( "(" #	( argument_list	| nil )	")"
			| nil #	) <xsref>.

io_statement	-> READ	  <xx>	 "(" io_unit conditions	")" io_list
		 | WRITE  <xx>	 "(" io_unit conditions	")" io_list
		 | PRINT  <xx>	     format_spec	    io_list
		 | PUNCH  <xx>	     format_spec	    io_list
		 | TYPE	  <xx>	     format_spec	    io_list
		 | ACCEPT <xx>	     format_spec	    io_list
		 | REREAD <xx>	     format_spec	    io_list
		 | ENCODE <xx>	 "(" encode_decode_spec	")" io_list
		 | DECODE <xx>	 "(" encode_decode_spec	")" io_list
		 | FIND	  <xx>	 "(" io_unit ")".

namelist_statement -> NAMELIST <xx>   "/" identifier "/" index_use
				    [ "/" identifier "/" index_use ].

file_control_statement ->
		   OPEN	  <xx>	 "(" [ -end_line ]
		 | CLOSE  <xx>	 "(" [ -end_line ].

format_statement -> FORMAT <xx>	  "(" [	-end_line ].

device_control_statement ->
		   REWIND <xx>		integer_item
		 | UNLOAD <xx>		integer_item
		 | BACKSPACE <xx>	integer_item
		 | ENDf	FILE <xx>	integer_item % endf <> end! beware %
		 | SKIP	( RECORD <xx>	integer_item
			| FILE <xx>	integer_item )
		 | BACKFILE <xx>	integer_item.

%	productions used by statements eg. expression	    %

index_spec	-> "(" <- array_identifier one_index [ "," one_index ] ")" <xdrop>
		 | nil <xdrop>.
one_index	-> integer_item	((":" |	"/") integer_item | nil).

common_spec	->    idx' <xlocal> index_spec
		[ "," idx' <xlocal> index_spec ].

index_use	->    idx' <xlocal> <xdrop> ( "(" integer_list ")" | nil )
		[ "," idx' <xlocal> <xdrop> ( "(" integer_list ")" | nil ) ].

	%:begin	2.3 -	"local_indexed_identifier": behaves like	%
	%	2.3	"indexed_identifier", but account for statement-%
	%:end	2.3	-function definition syntax...			%

local_indexed_identifier ->
		   identifier' <xx> <xlocal>
			      (	"(" <- function_identifier #
				   ( argument_list | nil) ")" <xldef>
			      |	nil )
		 | array_identifier'
			      (	"(" expression <xdrop> [ "," expression	<xdrop>	] ")"
			      |	nil	% for param. passing % )
		 | function_identifier'
			      (	"(" # argument_list ")"
			      |	nil # )	<xfref>.

indexed_identifier ->
		   identifier' <xx> <xlocal>
			      (	"(" <- function_identifier #
				   ( argument_list | nil ) ")" <xfref>
			      |	nil )
		 | array_identifier'
			      (	"(" expression <xdrop> [ "," expression	<xdrop>	] ")"
			      |	nil	% for param. passing % )
		 | function_identifier'
			      (	"(" # argument_list ")"
			      |	nil # )	<xfref>.

letter_list	-> idx'	("-" idx' | nil') [ ","	idx' ("-" idx' | nil') ].

integer_list	-> integer_item	[ "," integer_item ].

dummies		-> dummy   [ "," dummy ].
dummy		-> (idx' <xlocal> | "*"') <xdummy>.

io_list		-> ( "," | nil ) (data_list | nil).

argument_list	-> argument [ "," argument ].
argument	-> expression.

io_unit		-> integer_item	( "#" expression <xreset> | nil	).
format_spec	-> integer_item
		 | "*".
conditions	-> [ "," ( except ( "="	integer_constant	% ERR=... and END=... %
				  | nil		% variable format %)
			 | integer_constant		% format label %
			 | "*"			% free-format %)
		   ].
encode_decode_spec -> integer_item "," (integer_item | array_identifier) "," indexed_identifier	<xdrop>.

expression	-> expression_8	[ f10_logical_ops' expression_8	<xxtyp>	].
expression_8	-> expression_7	[ or'  expression_7 <xxtyp> ].
expression_7	-> expression_6	[ and' expression_6 <xxtyp> ].
expression_6	-> not expression_5
		 |     expression_5.
expression_5	-> expression_4	[ relop	 expression_4 <xxlog> ].
expression_4	-> expression_3	[ addop' expression_3 <xxtyp> ].
expression_3	-> expression_2	[ mulop' expression_2 <xxtyp> ].
expression_2	-> sign	expression_1
		 |	expression_1.
expression_1	-> item	 ( "**"' item <xxtyp> |	nil ).

item		-> constant' <xxstyp>		% constant %
		 | indexed_identifier <xxstyp> <xref>	% variable/array ref. %
		 | intrinsic_identifier'
			"(" # argument_list ")"	<xxsityp>	% intrinsic function call %
		 | "(" expression ( ")"		% back again %
				  | ","	expression ")" <xcmplx>
						% complex constants go here %
				  ).

type_id		-> simple_type'	( "*" integer_constant'	<xretyp>
				| nil )
		 | double' precision.

	%	stuff for DATA statement	%

data_list	-> data_item [ "," data_item ].
data_item	-> indexed_identifier <xdrop>
		 | implicit_do_loop.

implicit_do_loop ->
		   "(" data_item [ "," data_item ]
			   (   "=" expression <xdrop>
			       "," expression <xdrop>
			     ( "," expression <xdrop>
			     | nil )
			   | nil )
		   ")".

data_constant_list ->
		      x_constant ( "*" x_constant | nil	)
		[ "," x_constant ( "*" x_constant | nil	) ].

signed_constant	-> sign	constant
		 |	constant.

x_constant	-> "(" signed_constant "," signed_constant ")" % complex constant %
		 | signed_constant.