gram.expr

来自「<B>Digital的Unix操作系统VAX 4.2源码</B>」· EXPR 代码 · 共 217 行

/*
*	@(#)gram.expr	1.3	(ULTRIX)	1/15/86
*/

/************************************************************************
 *									*
 *			Copyright (c) 1986 by				*
 *		Digital Equipment Corporation, Maynard, MA		*
 *			All rights reserved.				*
 *									*
 *   This software is furnished under a license and may be used and	*
 *   copied  only  in accordance with the terms of such license and	*
 *   with the  inclusion  of  the  above  copyright  notice.   This	*
 *   software  or  any  other copies thereof may not be provided or	*
 *   otherwise made available to any other person.  No title to and	*
 *   ownership of the software is hereby transferred.			*
 *									*
 *   This software is  derived  from  software  received  from  the	*
 *   University    of   California,   Berkeley,   and   from   Bell	*
 *   Laboratories.  Use, duplication, or disclosure is  subject  to	*
 *   restrictions  under  license  agreements  with  University  of	*
 *   California and with AT&T.						*
 *									*
 *   The information in this software is subject to change  without	*
 *   notice  and should not be construed as a commitment by Digital	*
 *   Equipment Corporation.						*
 *									*
 *   Digital assumes no responsibility for the use  or  reliability	*
 *   of its software on equipment which is not supplied by Digital.	*
 *									*
 ************************************************************************/

/************************************************************************
*
*			Modification History
*
*	David Metsky		14-Jan-86
*
* 001	Replaced old version with BSD 4.3 version as part of upgrade.
*
*	Based on:	gram.expr	5.1		6/7/85
*
*************************************************************************/

/*
 * gram.expr
 *
 * Grammar for expressions, f77 compiler pass 1, 4.2 BSD.
 *
 * University of Utah CS Dept modification history:
 *
 * $Log:	gram.expr,v $
 * Revision 3.2  85/02/15  19:08:53  donn
 * Put OPPAREN operators in trees when not optimizing as well as when
 * optimizing -- this allows '(1)' to produce a writable temporary instead
 * of a read-only constant when passed as an argument to a subroutine.
 * 
 * Revision 3.1  84/10/13  00:42:08  donn
 * Installed Jerry Berkman's version with cosmetic changes.
 * 
 * Revision 1.2  84/08/04  21:27:05  donn
 * Added Jerry Berkman's fix to stop complaints about parentheses in
 * declarations.
 * 
 */

funarglist:
		{ $$ = 0; }
	| funargs
	;

funargs:  expr
		{ $$ = mkchain($1, CHNULL); }
	| funargs SCOMMA expr
		{ $$ = hookup($1, mkchain($3,CHNULL) ); }
	;


expr:	  uexpr
	| SLPAR expr SRPAR
		{ if (parstate != INDCL)
			$$ = mkexpr(OPPAREN, $2, ENULL);
		  else $$ = $2;
		}
	| complex_const
	;

uexpr:	  lhs
	| simple_const
	| expr addop expr   %prec SPLUS
		{ $$ = mkexpr($2, $1, $3); }
	| expr SSTAR expr
		{ $$ = mkexpr(OPSTAR, $1, $3); }
	| expr SSLASH expr
		{ $$ = mkexpr(OPSLASH, $1, $3); }
	| expr SPOWER expr
		{ $$ = mkexpr(OPPOWER, $1, $3); }
	| addop expr  %prec SSTAR
		{ if($1 == OPMINUS)
			$$ = mkexpr(OPNEG, $2, ENULL);
		  else 	$$ = $2;
		}
	| expr relop expr  %prec SEQ
		{ $$ = mkexpr($2, $1, $3); }
	| expr SEQV expr
		{ NO66(".EQV. operator");
		  $$ = mkexpr(OPEQV, $1,$3); }
	| expr SNEQV expr
		{ NO66(".NEQV. operator");
		  $$ = mkexpr(OPNEQV, $1, $3); }
	| expr SOR expr
		{ $$ = mkexpr(OPOR, $1, $3); }
	| expr SAND expr
		{ $$ = mkexpr(OPAND, $1, $3); }
	| SNOT expr
		{ $$ = mkexpr(OPNOT, $2, ENULL); }
	| expr SCONCAT expr
		{ NO66("concatenation operator //");
		  $$ = mkexpr(OPCONCAT, $1, $3); }
	;

addop:	  SPLUS		{ $$ = OPPLUS; }
	| SMINUS	{ $$ = OPMINUS; }
	;

relop:	  SEQ	{ $$ = OPEQ; }
	| SGT	{ $$ = OPGT; }
	| SLT	{ $$ = OPLT; }
	| SGE	{ $$ = OPGE; }
	| SLE	{ $$ = OPLE; }
	| SNE	{ $$ = OPNE; }
	;

lhs:	 name
		{ $$ = mkprim($1, PNULL, CHNULL); }
	| name substring
		{ NO66("substring operator :");
		  if( $1->vclass != CLPARAM ) {
		  	$$ = mkprim($1, PNULL, $2);
		  } else {
			errstr("substring of parameter %s",
				varstr(VL,$1->varname) );
			YYERROR ;
		  }
		}
	| name SLPAR funarglist SRPAR
		{ if( $1->vclass != CLPARAM ) {
		  	$$ = mkprim($1, mklist($3), CHNULL);
		  } else {
			errstr("can not subscript parameter %s",
				varstr(VL,$1->varname) );
			YYERROR ;
		  }
		}
	| name SLPAR funarglist SRPAR substring
		{ if( $1->vclass != CLPARAM ) {
		  	NO66("substring operator :");
		  	$$ = mkprim($1, mklist($3), $5);
		  } else {
			errstr("can not subscript parameter %s",
				varstr(VL,$1->varname) );
			YYERROR ;
		  }
		}
	;

substring:  SLPAR opt_expr SCOLON opt_expr SRPAR
		{ $$ = mkchain($2, mkchain($4,CHNULL)); }
	;

opt_expr:
		{ $$ = 0; }
	| expr
	;


simple_const:   STRUE	{ $$ = mklogcon(1); }
	| SFALSE	{ $$ = mklogcon(0); }
	| SHOLLERITH  { $$ = mkstrcon(toklen, token); }
	| SICON	= { $$ = mkintcon( convci(toklen, token) ); }
	| SRCON	= { $$ = mkrealcon(TYREAL, convcd(toklen, token)); }
	| SDCON	= { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); }
	;

complex_const:  SLPAR uexpr SCOMMA uexpr SRPAR
		{ $$ = mkcxcon($2,$4); }
	;


fexpr:	  unpar_fexpr
	| SLPAR fexpr SRPAR
		{ if (optimflag && parstate != INDCL)
			$$ = mkexpr(OPPAREN, $2, ENULL);
		  else $$ = $2;
		}
	;

unpar_fexpr:	  lhs
	| simple_const
	| fexpr addop fexpr   %prec SPLUS
		{ $$ = mkexpr($2, $1, $3); }
	| fexpr SSTAR fexpr
		{ $$ = mkexpr(OPSTAR, $1, $3); }
	| fexpr SSLASH fexpr
		{ $$ = mkexpr(OPSLASH, $1, $3); }
	| fexpr SPOWER fexpr
		{ $$ = mkexpr(OPPOWER, $1, $3); }
	| addop fexpr  %prec SSTAR
		{ if($1 == OPMINUS)
			$$ = mkexpr(OPNEG, $2, ENULL);
		  else	$$ = $2;
		}
	| fexpr SCONCAT fexpr
		{ NO66("concatenation operator //");
		  $$ = mkexpr(OPCONCAT, $1, $3); }
	;