pas.y

早期freebsd实现

/*-
 * Copyright (c) 1979, 1980, 1993
 *	The Regents of the University of California.  All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. All advertising materials mentioning features or use of this software
 *    must display the following acknowledgement:
 *	This product includes software developed by the University of
 *	California, Berkeley and its contributors.
 * 4. Neither the name of the University nor the names of its contributors
 *    may be used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 *
 *	@(#)pas.y	8.1 (Berkeley) 6/6/93
 */

/*
 * Yacc grammar for UNIX Pascal
 *
 * This grammar is processed by the commands in the shell script
 * "gram" to yield parse tables and semantic routines in the file
 * "y.tab.c" and a header defining the lexical tokens in "yy.h".
 *
 * In order for the syntactic error recovery possible with this
 * grammar to work, the grammar must be processed by a yacc which
 * has been modified to fully enumerate possibilities in states
 * which involve the symbol "error".
 * The parser used for Pascal also uses a different encoding of
 * the test entries in the action table which speeds the parse.
 * A version of yacc which will work for Pascal is included on
 * the distribution table as "eyacc".
 *
 * The "gram" script also makes the following changes to the "y.tab.c"
 * file:
 *
 *	1) Causes yyval to be declared int *.
 *
 *	2) Loads the variable yypv into a register as yyYpv so that
 *	   the arguments $1, ... are available as yyYpv[1] etc.
 *	   This produces much smaller code in the semantic actions.
 *
 *	3) Deletes the unused array yysterm.
 *
 *	4) Moves the declarations up to the flag line containing
 *	   '##' to the file yy.h so that the routines which use
 *	   these "magic numbers" don't have to all be compiled at
 *	   the same time.
 *
 *	5) Creates the semantic restriction checking routine yyEactr
 *	   by processing action lines containing `@@'.
 *
 * This compiler uses a different version of the yacc parser, a
 * different yyerror which is called yerror, and requires more
 * lookahead sets than normally provided by yacc.
 *
 * Source for the yacc used with this grammar is included on
 * distribution tapes.
 */

/*
 * TERMINAL DECLARATIONS
 *
 * Some of the terminal declarations are out of the most natural
 * alphabetic order because the error recovery
 * will guess the first of equal cost non-terminals.
 * This makes, e.g. YTO preferable to YDOWNTO.
 */

%term
	YAND		YARRAY		YBEGIN		YCASE
	YCONST		YDIV		YDO		YDOTDOT
	YTO		YELSE		YEND		YFILE
	YFOR		YFORWARD	YPROCEDURE	YGOTO
	YID		YIF		YIN		YINT
	YLABEL		YMOD		YNOT		YNUMB
	YOF		YOR		YPACKED		YNIL
	YFUNCTION	YPROG		YRECORD		YREPEAT
	YSET		YSTRING		YTHEN		YDOWNTO
	YTYPE		YUNTIL		YVAR		YWHILE
	YWITH		YBINT		YOCT		YHEX
	YCASELAB	YILLCH		YEXTERN		YLAST

/*
 * PRECEDENCE DECLARATIONS
 *
 * Highest precedence is the unary logical NOT.
 * Next are the multiplying operators, signified by '*'.
 * Lower still are the binary adding operators, signified by '+'.
 * Finally, at lowest precedence and non-associative are the relationals.
 */

%binary	'<'	'='	'>'	YIN
%left	'+'	'-'	YOR	'|'
%left	UNARYSIGN
%left	'*'	'/'	YDIV	YMOD	YAND	'&'
%left	YNOT

%{
/*
 * GLOBALS FOR ACTIONS
 */

/* Copyright (c) 1979 Regents of the University of California */

/* static	char sccsid[] = "@(#)pas.y 8.1 6/6/93"; */

/*
 * The following line marks the end of the yacc
 * Constant definitions which are removed from
 * y.tab.c and placed in the file y.tab.h.
 */
##
/* Copyright (c) 1979 Regents of the University of California */

static	char sccsid[] = "@(#)pas.y 8.1 6/6/93";

#include "whoami.h"
#include "0.h"
#include "tree_ty.h"		/* must be included for yy.h */
#include "yy.h"
#include "tree.h"

#ifdef PI
#define	lineof(l)	l
#define	line2of(l)	l
#endif

%}

%%

/*
 * PRODUCTIONS
 */

goal:
	prog_hedr decls block '.'
		= funcend($1.nl_entry, $3.tr_entry, lineof($4.i_entry));
		|
	decls
		= segend();
		;
	

prog_hedr:
	YPROG YID '(' id_list ')' ';' 
		= $$.nl_entry = funcbody(funchdr(tree5(T_PROG, lineof($1.i_entry), $2.tr_entry, fixlist($4.tr_entry), TR_NIL)));
		|
	YPROG YID ';'
		= $$.nl_entry = funcbody(funchdr(tree5(T_PROG, lineof($1.i_entry),  $2.tr_entry, TR_NIL, TR_NIL)));
		|
	YPROG error
		= {
			yyPerror("Malformed program statement", PPROG);
			/*
			 * Should make a program statement
			 * with "input" and "output" here.
			 */
			$$.nl_entry = funcbody(funchdr(tree5(T_PROG, lineof($1.i_entry), TR_NIL, TR_NIL, TR_NIL)));
		  }
		;
block:
	YBEGIN stat_list YEND
		= {
			$$.tr_entry = tree3(T_BSTL, lineof($1.i_entry), fixlist($2.tr_entry));
			if ($3.i_entry < 0)
				brerror($1.i_entry, "begin");
		  }
		;


/*
 * DECLARATION PART
 */
decls:
	decls decl
		= trfree();
		|
	decls error
		= {
			constend(), typeend(), varend(), trfree();
			yyPerror("Malformed declaration", PDECL);
		  }
		|
	/* lambda */
		= trfree();
		;

decl:
	labels
		|
	const_decl
		= constend();
		|
	type_decl
		= typeend();
		|
	var_decl
		= varend();
		|
	proc_decl
		;

/*
 * LABEL PART
 */

labels:
	YLABEL label_decl ';'
		= label(fixlist($2.tr_entry), lineof($1.i_entry));
		;
label_decl:
	YINT
		= $$.tr_entry = newlist($1.i_entry == NIL ? TR_NIL :
					(struct tnode *) *hash($1.cptr, 1));
		|
	label_decl ',' YINT
		= $$.tr_entry = addlist($1.tr_entry, $3.i_entry == NIL ?
				TR_NIL : (struct tnode *) *hash($3.cptr, 1));
		;

/*
 * CONST PART
 */

const_decl:
	YCONST YID '=' const ';'
		= constbeg($1.i_entry, lineof($1.i_entry)),
		  constant(lineof($3.i_entry), $2.cptr, $4.tr_entry);
		|
	const_decl YID '=' const ';'
		= constant(lineof($3.i_entry), $2.cptr, $4.tr_entry);
		|
	YCONST error
		= {
			constbeg($1.i_entry);
Cerror:
			yyPerror("Malformed const declaration", PDECL);
		  }
		|
	const_decl error
		= goto Cerror;
		;

/*
 * TYPE PART
 */

type_decl:
	YTYPE YID '=' type ';'
		= typebeg($1.i_entry, line2of($2.i_entry)), type(lineof($3.i_entry), $2.cptr, $4.tr_entry);
		|
	type_decl YID '=' type ';'
		= type(lineof($3.i_entry), $2.cptr, $4.tr_entry);
		|
	YTYPE error
		= {
			typebeg($1.i_entry, line2of($1.i_entry));
Terror:
			yyPerror("Malformed type declaration", PDECL);
		  }
		|
	type_decl error
		= goto Terror;
		;

/*
 * VAR PART
 */

var_decl:
	YVAR id_list ':' type ';'
		= varbeg($1.i_entry, line2of($3.i_entry)), var(lineof($3.i_entry), fixlist($2.tr_entry), $4.tr_entry);
		|
	var_decl id_list ':' type ';'
		= var(lineof($3.i_entry), fixlist($2.tr_entry), $4.tr_entry);
		|
	YVAR error 
		= {
			varbeg($1.i_entry, line2of($1.i_entry));
Verror:
			yyPerror("Malformed var declaration", PDECL);
		  }
		|
	var_decl error
		= goto Verror;
		;

/*
 * PROCEDURE AND FUNCTION DECLARATION PART
 */

proc_decl:
	phead YFORWARD ';'
		= funcfwd($1.nl_entry);
		|
	phead YEXTERN ';'
		= (void) funcext($1.nl_entry);
		|
	pheadres decls block ';'
		= funcend($1.nl_entry, $3.tr_entry, lineof($4.i_entry));
		|
	phead error
		;
pheadres:
	phead
		= (void) funcbody($1.nl_entry);
		;
phead:
	porf YID params ftype ';'
		= $$.nl_entry = funchdr(tree5($1.i_entry, lineof($5.i_entry),
				$2.tr_entry, $3.tr_entry, $4.tr_entry));
		;
porf:
	YPROCEDURE
		= $$.i_entry = T_PDEC;
		|
	YFUNCTION
		= $$.i_entry = T_FDEC;
		;
params:
	'(' param_list ')'
		= $$.tr_entry = fixlist($2.tr_entry);
		|
	/* lambda */
		= $$.tr_entry = TR_NIL;
		;

/*
 * PARAMETERS
 */

param:
	id_list ':' type
		= $$.tr_entry = tree3(T_PVAL, (int) fixlist($1.tr_entry), $3.tr_entry);
		|
	YVAR id_list ':' type
		= $$.tr_entry = tree3(T_PVAR, (int) fixlist($2.tr_entry), $4.tr_entry);
		|
	YFUNCTION id_list params ftype
		= $$.tr_entry = tree5(T_PFUNC, (int) fixlist($2.tr_entry),
				$4.tr_entry, $3.tr_entry, 
				(struct tnode *) lineof($1.i_entry));
		|
	YPROCEDURE id_list params ftype
		= $$.tr_entry = tree5(T_PPROC, (int) fixlist($2.tr_entry),
				$4.tr_entry, $3.tr_entry, 
				(struct tnode *) lineof($1.i_entry));
		;
ftype:
	':' type
		= $$ = $2;
		|
	/* lambda */
		= $$.tr_entry = TR_NIL;
		;
param_list:
	param
		= $$.tr_entry = newlist($1.tr_entry);
		|
	param_list ';' param
		= $$.tr_entry = addlist($1.tr_entry, $3.tr_entry);
		;

/*
 * CONSTANTS
 */

const:
	YSTRING
		= $$.tr_entry = tree2(T_CSTRNG, $1.i_entry);
		|
	number
		|
	'+' number
		= $$.tr_entry = tree2(T_PLUSC, $2.i_entry);
		|
	'-' number
		= $$.tr_entry = tree2(T_MINUSC, $2.i_entry);
		;
number:
	const_id
		= $$.tr_entry = tree2(T_ID, $1.i_entry);
		|
	YINT
		= $$.tr_entry = tree2(T_CINT, $1.i_entry);
		|
	YBINT
		= $$.tr_entry = tree2(T_CBINT, $1.i_entry);
		|
	YNUMB
		= $$.tr_entry = tree2(T_CFINT, $1.i_entry);
		;
const_list:
	const
		= $$.tr_entry = newlist($1.tr_entry);
		|
	const_list ',' const
		= $$.tr_entry = addlist($1.tr_entry, $3.tr_entry);
		;

/*
 * TYPES
 */

type:
	simple_type
		|
	'^' YID
		= $$.tr_entry = tree3(T_TYPTR, lineof($1.i_entry), tree2(T_ID,
								$2.i_entry));
		|
	struct_type
		|
	YPACKED struct_type
		= $$.tr_entry = tree3(T_TYPACK, lineof($1.i_entry), $2.tr_entry);
		;
simple_type:
	type_id
		|
	'(' id_list ')'
		= $$.tr_entry = tree3(T_TYSCAL, lineof($1.i_entry), fixlist($2.tr_entry));
		|
	const YDOTDOT const
		= $$.tr_entry = tree4(T_TYRANG, lineof($2.i_entry), $1.tr_entry,
				$3.tr_entry);
		;
struct_type:
	YARRAY '[' simple_type_list ']' YOF type
		= $$.tr_entry = tree4(T_TYARY, lineof($1.i_entry),
					fixlist($3.tr_entry), $6.tr_entry);
		|
	YFILE YOF type
		= $$.tr_entry = tree3(T_TYFILE, lineof($1.i_entry), $3.tr_entry);
		|
	YSET YOF simple_type
		= $$.tr_entry = tree3(T_TYSET, lineof($1.i_entry), $3.tr_entry);
		|
	YRECORD field_list YEND
		= {
			$$.tr_entry = setuptyrec( lineof( $1.i_entry ) , $2.tr_entry);
			if ($3.i_entry < 0)
				brerror($1.i_entry, "record");
		  }
		;
simple_type_list:
	simple_type
		= $$.tr_entry = newlist($1.tr_entry);
		|
	simple_type_list ',' simple_type
		= $$.tr_entry = addlist($1.tr_entry, $3.tr_entry);
		;

/*
 * RECORD TYPE
 */
field_list:
	fixed_part variant_part
		= $$.tr_entry = tree4(T_FLDLST, lineof(NIL), 
				fixlist($1.tr_entry), $2.tr_entry);
		;
fixed_part:
	field
		= $$.tr_entry = newlist($1.tr_entry);
		|
	fixed_part ';' field
		= $$.tr_entry = addlist($1.tr_entry, $3.tr_entry);
		|
	fixed_part error
		= yyPerror("Malformed record declaration", PDECL);
		;
field:
	/* lambda */
		= $$.tr_entry = TR_NIL;
		|