pascal-grammar

来自「this is a lp0 compilator new」· 代码 · 共 787 行 · 第 1/2 页

	Xextern	int	yylineno;
	Xextern	char	yytext[];
	Xextern	char	numbertext[80];
	Xextern	char	*laststring;
	Xextern	char	lastident[];
	X
	Xextern  char	*create_string();
	X
	X#define YYSTYPE item
	X
	X
	Xint	lexical_level = 0;
	X
	Xstatic	int	param_level = 0;
	Xstatic	char *its_a = "error - uninitialised";
	X
	X%}
	X
	X%start program
	X
	X%token UNSIGNED_INT UNSIGNED_REAL STRING IDENTIFIER
	X%token NE LE GE BECOMES DIV MOD NIL IN OR AND NOT DOTDOT
	X%token IF THEN ELSE CASE OF REPEAT UNTIL WHILE DO FOR TO DOWNTO
	X%token SBEGIN END WITH GOTO CONST VAR TYPE ARRAY RECORD SET SFILE FUNCTION
	X%token PROCEDURE LABEL PACKED PROGRAM
	X
	X%%   /*start of rules*/
	Xprogram		: PROGRAM {its_a="program";} newident external_files ';' 
	X			block '.'
	X		;
	Xexternal_files  : /*empty*/
	X		| '(' {its_a="external-file";} newident_list ')'
	X		;
	X
	Xblock		: opt_declarations  statement_part
	X		;
	Xopt_declarations: /*empty*/
	X		| declarations
	X		;
	Xdeclarations	: declarations declaration	/*should be left-recursive*/
	X		| declaration
	X		;
	Xdeclaration	: label_dcl_part
	X		| const_dcl_part
	X		| type_dcl_part
	X		| var_dcl_part
	X		| proc_dcl_part
	X		;
	X
	Xlabel_dcl_part	: LABEL labels ';'
	X		;
	Xlabels		: labels ',' label
	X		| label
	X		;
	Xlabel		: UNSIGNED_INT		/* 0 <= value <= 9999 [6.1.6] */
	X		;
	X
	Xconst_dcl_part	: CONST const_defs ';'
	X		;
	Xconst_defs	: const_defs ';' const_def
	X		| const_def
	X		;
	Xconst_def	: {its_a="constant";} newident '=' constant
	X		;
	X
	Xconstant	: unsigned_num
	X		| '+' unsigned_num
	X		| '-' unsigned_num
	X		| ident				/*check it is constant*/
	X		| '+' ident
	X		| '-' ident
	X		| STRING			/*type is char if len=1*/
	X		;
	X
	Xunsigned_num	: UNSIGNED_INT
	X		| UNSIGNED_REAL
	X		;
	X
	Xtype_dcl_part	: TYPE type_defs ';'
	X		;
	Xtype_defs	: type_defs ';' type_def
	X		| type_def
	X		;
	Xtype_def	: {its_a="type";} newident '=' type
	X		;
	X
	Xtype		: simple_type
	X		| PACKED struct_type
	X		| struct_type
	X		| '^' IDENTIFIER    /*check forward reference semantics*/
	X		;
	X
	Xsimple_type	: '(' {its_a="enumerated-literal";} newident_list ')'
	X		| constant DOTDOT constant
	X		| ident
	X		;
	X
	Xstruct_type	: ARRAY '[' index_t_list ']' OF type
	X		| RECORD /*consider this a scope*/ field_list END
	X		| SET OF simple_type
	X		| SFILE OF type
	X		;
	Xindex_t_list	: index_t_list ',' simple_type
	X		| simple_type
	X		;
	Xfield_list	: fixed_part
	X		| fixed_part ';' variant_part
	X		| variant_part
	X		;
	Xfixed_part	: fixed_part ';' record_section
	X		| record_section
	X		;
	Xrecord_section	: {its_a="field";} newident_list ':' type
	X		| /*empty*/
	X		;
	Xvariant_part	: CASE {its_a="field";} tag_field OF variants
	X		;
	Xtag_field	: newident ':' ident 
	X		| ident /*type*/
	X		;
	Xvariants	: variants ';' variant
	X		| variant
	X		;
	Xvariant		: case_label_list ':' '(' field_list ')'
	X		| /*empty*/
	X		;
	X
	Xvar_dcl_part	: VAR variable_dcls ';'
	X		;
	Xvariable_dcls	: variable_dcls ';' variable_dcl
	X		| variable_dcl
	X		;
	Xvariable_dcl	: {its_a="variable";} newident_list ':' type
	X		;
	Xnewident_list	: new_id_list {its_a="don't know";}
	X		;
	Xnew_id_list	: new_id_list ',' newident
	X		| newident
	X		;
	X
	Xproc_dcl_part	: proc_or_func
	X		;
	Xproc_or_func	: proc_heading ';' body ';'     /*check if forward or fwd refd*/
	X			{lexical_level--;
	X			}
	X		| func_heading ';' body ';'  /*also func heading may be -type */
	X			{lexical_level--;
	X			}
	X		;
	Xproc_heading	: PROCEDURE
	X			{if(param_level==0)its_a="procedure";}
	X		  newident {lexical_level++;}
	X			formal_params
	X		;
	Xfunc_heading	: FUNCTION
	X			{if(param_level==0)its_a="function";}
	X		  newident {lexical_level++;}
	X			function_form
	X		;
	Xfunction_form	: /*empty*/			/*if forward referenced*/
	X		| formal_params ':' ident
	X		;
	X
	Xbody		: block
	X			/* result determined in block */
	X		| IDENTIFIER				/*directive-FORWARD*/
	X		;
	Xformal_params	: /*empty*/
	X		| '(' {param_level++;} formal_p_sects ')' {param_level--;}
	X		;
	Xformal_p_sects	: formal_p_sects ';' formal_p_sect
	X		| formal_p_sect
	X		;
	Xformal_p_sect	: {its_a="value-parameter";} param_group
	X		| VAR {its_a="var-parameter";} param_group
	X		| {its_a="procedure-parameter";} proc_heading
	X			{lexical_level--;}
	X		| {its_a="function-parameter";} func_heading  {lexical_level--;}
	X		;
	Xparam_group	: newident_list ':' paramtype
	X		;
	Xparamtype	: ident
	X		| ARRAY '[' index_specs ']' OF paramtype
	X		| PACKED ARRAY '[' index_spec ']' OF ident
	X		;
	Xindex_specs	: index_specs ';' index_spec
	X		| index_spec
	X		;
	Xindex_spec	: {its_a="conformant-bound";} newident DOTDOT newident ':' ident
	X		;
	X
	Xstatement_part	: compound_stmt
	X		;
	Xcompound_stmt	: SBEGIN statements END
	X		;
	Xstatements	: statements ';' statement
	X		| statement
	X		;
	Xstatement	: /*empty*/
	X		| label ':' statement
	X		| compound_stmt
	X		| assignment
	X		| procedure_call
	X		| GOTO label
	X		| IF expression THEN statement
	X		| IF expression THEN statement ELSE statement
	X		| CASE expression OF case_list END
	X		| WHILE expression DO statement
	X		| REPEAT statements UNTIL expression
	X		| FOR ident BECOMES expression direction expression DO statement
	X		| WITH rec_var_list DO statement 
	X		;
	Xdirection	: TO
	X		| DOWNTO
	X		;
	X
	Xassignment	: variable BECOMES expression	/* must test for fn_ident */
	X	/*	| ident BECOMES expression	*/
	X		;
	X
	Xprocedure_call	: ident actual_params
	X		;
	X
	Xactual_params	:  /*empty*/
	X		| '(' actuals_list ')'
	X		;
	Xactuals_list	: actuals_list ',' actual_param
	X		| actual_param
	X		;
	Xactual_param	: expression    /* which could be a variable or a proc/fn id */
	X		| expression colon_things  /* only in i/o */
	X		;
	Xcolon_things    : ":" expression	/*integer*/
	X		| ":" expression ":" expression 
	X		;
	X
	Xcase_list	: case_list ';' case_list_elem
	X		| case_list_elem
	X		;
	Xcase_list_elem	: case_label_list ':' statement
	X		| /*empty*/
	X		;
	Xcase_label_list	: case_label_list ',' case_label
	X		| case_label
	X		;
	Xcase_label	: constant
	X		;
	X
	Xrec_var_list	: rec_var_list ',' record_var
	X		| record_var
	X		;
	X
	Xexpression	: simple_expr
	X		| simple_expr relational_op simple_expr
	X		;
	Xrelational_op	: '='
	X		| '<'
	X		| '>'
	X		| LE
	X		| GE
	X		| NE
	X		| IN
	X		;
	X
	Xsimple_expr	: term
	X		| '+' term
	X		| '-' term
	X		| simple_expr add_op term
	X		;
	Xadd_op		: '+'
	X		| '-'
	X		| OR
	X		;
	X
	Xterm		: factor
	X		| term mult_op factor
	X		;
	Xmult_op		: '*'
	X		| '/'
	X		| DIV
	X		| MOD
	X		| AND
	X		;
	X
	Xfactor		: variable		/* could be a const_ident of fn_call*/
	X		| unsigned_lit
	X		| '(' expression ')'
	X	/*	| function_call		*/
	X		| set
	X		| NOT factor
	X		;
	X
	Xunsigned_lit	: unsigned_num
	X		| STRING			/*type is char if len=1*/
	X		| NIL
	X		;
	X/*
	Xfunction_call	: ident actual_params
	X		;
	X*/
	X
	Xset		: '[' member_list ']'
	X		;
	Xmember_list	: /*empty*/
	X		| members
	X		;
	Xmembers		: members ',' member
	X		| member
	X		;
	Xmember		: expression
	X		| expression DOTDOT expression
	X		;
	X
	X/* kludge */
	Xvariable	: ident actual_params	/* check variable, const_id, fn_call */
	X		| variable '[' expressions ']'
	X		| variable '.' ident
	X		| variable '^'
	X		;
	Xexpressions	: expressions ',' expression
	X		| expression
	X		;
	Xrecord_var	: variable
	X		;
	Xident		: IDENTIFIER
	X		;
	Xnewident	: IDENTIFIER
	X		    { 
	X			if(param_level<2)
	X			    printf("%s\t%s\n", its_a, lastident);
	X		    }
	X		;
	X%%   /*start of routines*/
	X
	Xyyerror(msg) char *msg;
	X{
	X    if(msg==NULL || *msg=='\0')
	X	fprintf(stderr, "Error at %s near line %d\n",
	X				token_name(yychar), yylineno);
	X    else
	X	fprintf(stderr, "Error at %s near line %d : %s\n",
	X				token_name(yychar), yylineno, msg);
	X    exit(1);
	X}
	X
	Xparser_info()
	X{
	X    printf("\n%d line%s parsed\n", yylineno, plural(yylineno));
	X}
	X
	X
	Xinternal_error(s,a1,a2,a3,a4)
	X{
	X    fprintf(stderr, "Internal error: ");
	X    fprintf(stderr, s, a1, a2, a3, a4);
	X    exit(2);
	X}
	X
	Xwarning(fmt, a1, a2, a3, a4)
	X{
	X    fprintf(stderr, "Warning line %d: ", yylineno);
	X    fprintf(stderr, fmt, a1, a2, a3, a4);
	X    fprintf(stderr, "\n");
	X}
	X
	Xmain()
	X{
	X    yyparse();
	X}
SHAR_EOF
if test 7510 -ne "`wc -c < 'pascal.y'`"
then
	echo shar: "error transmitting 'pascal.y'" '(should have been 7510 characters)'
fi
fi
echo shar: "extracting 'types.h'" '(115 characters)'
if test -f 'types.h'
then
	echo shar: "will not over-write existing file 'types.h'"
else
sed 's/^	X//' << \SHAR_EOF > 'types.h'
	X#define pluralsuffix(num,suffix)	((num)==1?"":(suffix))
	X#define plural(num)	pluralsuffix(num,"s")
	X#define item int
SHAR_EOF
if test 115 -ne "`wc -c < 'types.h'`"
then
	echo shar: "error transmitting 'types.h'" '(should have been 115 characters)'
fi
fi
exit 0
#	End of shell archive