DataMuseum.dk

top - download

    Length: 14997 (0x3a95)
    Types: TextFile
    Names: »calc.y«

└─⟦87ddcff64⟧ Bits:30001253 CPHDIST85 Tape, 1985 Autumn Conference Copenhagen
    └─ ⟦this⟧ »cph85dist/stat/src/calc.y« 

TextFile

%{
/* Copyright (c) 1982 Gary Perlman (see Copyright file) */
static	char	sccsid[] = "@(#) calc.y 5.0 (unix|stat) 2/26/85";
/* PGM(calc, Algebraic Modeling Calculator) */
#include <stdio.h>
#include <math.h>
#include <ctype.h>
#include <signal.h>

#define	FZERO 10e-10
#define	fzero(x) (fabs (x) < FZERO)
#define	isvarchar(c) (isalnum (c) || (c) == '_')

#ifndef iscntrl
#define iscntrl(a) ((a)>0&&(a)<26)
#endif
#define OPERATOR     1
#define PARSERROR    1
#define	MAXVAR    1000 
#define	UNDEFINED   -99999999999.987654321
int 	Nvar = 0;
char	*Varname[MAXVAR];
char	*Exprptr;
int 	Printequation = 1;
char	*Prompt = "CALC: ";
int 	Interactive = 0;
typedef struct	exprnode
	{
	int 	nodetype;          /* NUMBER, OPERATOR, or VARIABLE */
	int 	operator;          /* index of var if a variable, else +/-* */
	double	*value;
	struct	exprnode *left;
	struct	exprnode *right;
	} ENODE;
ENODE	*Expression, *Variable[MAXVAR];
double	eval (), answer;
double	*constant;
char	*malloc ();
char	*getline ();
FILE	*outfile = stdout;
%}
%token	NUMBER
%token	VARIABLE
%nonassoc '#'
%right	'='
%left	'?' IF THEN
%left	':' ELSE
%left	'|'
%left	'&'
%nonassoc '!'
%nonassoc EQ NE GE LE '<' '>'
%left	'+' '-'
%left	'*' '/' '%'
%right	'^'
%nonassoc UMINUS ABS EXP LOG SQRT COS TAN SIN ACOS ASIN ATAN
%%
start:
	expr = { Expression = (ENODE *) $1;};
expr :
	'('  expr ')' = { $$ = $2; }|
	VARIABLE '=' expr = {
			if (checkrecursion ($1, (ENODE *) $3))
				{
				fprintf (stderr, "Can't have recursive definitions\n");
				Variable[$1] = NULL;
				}
			else Variable[$1] = (ENODE *) $3;
			$$ = $3;
		}|
	'#' expr = { constant = (double *) malloc (sizeof (double));
		if (constant == NULL)
			errorexit ("Out of storage space");
		*constant = eval ((ENODE *) $2);
		$$ = (int) node ((int) constant, NUMBER, NULL, NULL); }|
	expr '+' expr = { $$ = (int) node ('+', OPERATOR, $1, $3); }|
	expr '-' expr = { $$ = (int) node ('-', OPERATOR, $1, $3); }|
	expr '*' expr = { $$ = (int) node ('*', OPERATOR, $1, $3); }|
	expr '%' expr = { $$ = (int) node ('%', OPERATOR, $1, $3); }|
	expr '/' expr = { $$ = (int) node ('/', OPERATOR, $1, $3); }|
	expr '^' expr = { $$ = (int) node ('^', OPERATOR, $1, $3); }|
	'-' expr %prec UMINUS
		= { $$ = (int) node ('_', OPERATOR, NULL, $2); }|
	expr EQ expr = { $$ = (int) node (EQ, OPERATOR, $1, $3); }|
	expr NE expr = { $$ = (int) node (NE, OPERATOR, $1, $3); }|
	expr LE expr = { $$ = (int) node (LE, OPERATOR, $1, $3); }|
	expr '<' expr = { $$ = (int) node ('<', OPERATOR, $1, $3); }|
	expr GE expr = { $$ = (int) node (GE, OPERATOR, $1, $3); }|
	expr '>' expr = { $$ = (int) node ('>', OPERATOR, $1, $3); }|
	expr '&' expr = { $$ = (int) node ('&', OPERATOR, $1, $3); }|
	expr '|' expr = { $$ = (int) node ('|', OPERATOR, $1, $3); }|
	'!' expr      = { $$ = (int) node ('!', OPERATOR, NULL, $2); }|
	expr '?' expr ':' expr = { $$ = (int) node ('?', OPERATOR, $1,
		(int) node (':', OPERATOR, $3, $5)); }|
	IF expr THEN expr = { $$ = (int) node ('?', OPERATOR, $2, $4); }|
	expr ELSE expr = { $$ = (int) node (':', OPERATOR, $1, $3); }|
	ACOS expr = { $$ = (int) node (ACOS, OPERATOR, NULL, $2); }|
	ASIN expr = { $$ = (int) node (ASIN, OPERATOR, NULL, $2); }|
	ATAN expr = { $$ = (int) node (ATAN, OPERATOR, NULL, $2); }|
	COS expr = { $$ = (int) node (COS, OPERATOR, NULL, $2); }|
	SIN expr = { $$ = (int) node (SIN, OPERATOR, NULL, $2); }|
	TAN expr = { $$ = (int) node (TAN, OPERATOR, NULL, $2); }|
	LOG expr = { $$ = (int) node (LOG, OPERATOR, NULL, $2); }|
	EXP expr = { $$ = (int) node (EXP, OPERATOR, NULL, $2); }|
	ABS expr = { $$ = (int) node (ABS, OPERATOR, NULL, $2); }|
	SQRT expr = { $$ = (int) node (SQRT, OPERATOR, NULL, $2); }|
	VARIABLE = { $$ = (int) node ($1, VARIABLE, NULL, NULL); }|
	NUMBER = { $$ = (int) node ($1, NUMBER, NULL, NULL); };
%%

yylex ()
	{
	extern	int yylval;
	char	tmpvarname[BUFSIZ];
	int 	i;
	while (isspace (*Exprptr)) Exprptr++;
	if (begins ("acos", Exprptr)) {Exprptr += 4; return (ACOS);}
	if (begins ("asin", Exprptr)) {Exprptr += 4; return (ASIN);}
	if (begins ("atan", Exprptr)) {Exprptr += 4; return (ATAN);}
	if (begins ("cos", Exprptr)) {Exprptr += 3; return (COS);}
	if (begins ("sin", Exprptr)) {Exprptr += 3; return (SIN);}
	if (begins ("tan", Exprptr)) {Exprptr += 3; return (TAN);}
	if (begins ("log", Exprptr)) {Exprptr += 3; return (LOG);}
	if (begins ("sqrt", Exprptr)) {Exprptr += 4; return (SQRT);}
	if (begins ("exp", Exprptr)) {Exprptr += 3; return (EXP);}
	if (begins ("abs", Exprptr)) {Exprptr += 3; return (ABS);}
	if (begins ("if", Exprptr)) {Exprptr += 2; return (IF);}
	if (begins ("then", Exprptr)) {Exprptr += 4; return (THEN);}
	if (begins ("else", Exprptr)) {Exprptr += 4; return (ELSE);}
	if (isdigit (*Exprptr) || *Exprptr == '.')
		{
		constant = (double *) malloc (sizeof (double));
		if (constant == NULL)
			errorexit ("Out of storage space");
		*constant = atof (Exprptr);
		yylval = (int) constant;
		/* now skip over the number */
		while (isdigit (*Exprptr)) Exprptr++;
		if (*Exprptr == '.') Exprptr++;
		while (isdigit (*Exprptr)) Exprptr++;
		if (*Exprptr == 'E' || *Exprptr == 'e')
			{
			Exprptr++;
			if (*Exprptr == '+' || *Exprptr == '-') Exprptr++;
			while (isdigit (*Exprptr)) Exprptr++;
			}
		return (NUMBER);
		}
	if (isvarchar (*Exprptr))
		{
		for (i = 0; isvarchar (Exprptr[i]); i++)
			tmpvarname[i] = Exprptr[i];
		tmpvarname[i] = NULL;
		Exprptr += i;
		i = 0;
		while (i < Nvar && strcmp (tmpvarname, Varname[i])) i++;
		if (i == Nvar)
			{
			Varname[i] = malloc (strlen (tmpvarname) + 1);
			if (Varname[i] == NULL)
				errorexit ("Out of storage space");
			strcpy (Varname[i], tmpvarname);
			if (++Nvar == MAXVAR)
				errorexit ("Too many variables");
			}
		yylval = i;
		return (VARIABLE);
		}
	if (begins ("!=", Exprptr)) { Exprptr += 2; return (NE); }
	if (begins (">=", Exprptr)) { Exprptr += 2; return (GE); }
	if (begins ("<=", Exprptr)) { Exprptr += 2; return (LE); }
	if (begins ("==", Exprptr)) { Exprptr += 2; return (EQ); }
	if (begins ("**", Exprptr)) { Exprptr += 2; return ('^'); }
	return (*Exprptr++);
	}

yyerror (msg)
char	*msg;
	{
	fprintf (outfile, "%s:\n", msg);
	fprintf (outfile, "Parsing error.  ");
	fprintf (outfile, "This is left in input: [%s]\n", Exprptr-1);
	}

ENODE *
node (datum, datatype, lson, rson)
int 	datum;        /* pointer to a number or an operator */
int 	datatype;     /* NUMBER or VARIABLE or OPERATOR */
ENODE	*lson;        /* left part of tree */
ENODE	*rson;        /* right part of tree */
	{
	ENODE *newnode;
	newnode = (ENODE *) malloc (sizeof (ENODE));
	if (newnode == NULL)
		errorexit ("Out of storage space");
	newnode->nodetype = datatype;
	if (datatype == OPERATOR || datatype == VARIABLE)
		newnode->operator = datum;
	else newnode->value = (double *) datum;
	newnode->left = lson;
	newnode->right = rson;
	return (newnode);
	}

main (argc, argv) int argc; char *argv[];
	{
	int 	i;
	signal (SIGINT, SIG_IGN);
	if (isatty (0))
		{
		Interactive = 1;
		printf ("Enter expressions after the prompt '%s'\n", Prompt);
		printf ("Quit with ^D, get help with ?\n");
		}
	for (i = 1; i < argc; i++) process (argv[i]);
	process ("-");
	if (Interactive) printf ("\015           \015");
	exit (0);
	}

process (filename) char *filename;
	{
	char	exprline[BUFSIZ];
	FILE	*ioptr;
	if (filename == NULL || (filename[0] == '-' && filename[1] == '\0'))
		{
		ioptr = stdin;
		filename = NULL;
		}
	else if ((ioptr = fopen (filename, "r")) == NULL)
		{
		fprintf (stderr, "Can't open %s\n", filename);
		return;
		}
	if (filename) fprintf (outfile, "Reading from %s\n", filename);
	for (;;)
		{
		if (ioptr == stdin && Interactive)
			fprintf (outfile, Prompt);
		if (!getline (exprline, ioptr)) break;
		Exprptr = exprline;
		while (isspace (*Exprptr)) Exprptr++;
		if (!*Exprptr || *Exprptr == '?')
			{
			if (filename == NULL && Interactive) printmenu ();
			continue;
			}
		if (iscntrl (*Exprptr))
			{
			control (Exprptr);
			continue;
			}
		if (yyparse() == PARSERROR)
			continue;
		if (Printequation || ioptr != stdin)
			ptree (outfile, Expression);
		if (fzero (answer = eval (Expression)))
			answer = 0.0;
		if (Printequation)
			printf (" =");
		if (answer == UNDEFINED)
			fprintf (outfile, "\tUNDEFINED\n");
		else fprintf (outfile, "\t%g\n", answer);
		}
	if (ioptr != stdin) fclose (ioptr);
	}

printmenu ()
	{
	puts ("Expressions are in standard C syntax (like algebra).");
	puts ("The following CTRL characters have special functions:");
	puts ("(You may have to precede the character with a ^V)");
	puts ("^D	end of input to CALC");
	puts ("^P	toggles the printing of equations");
	puts ("^Rfile	reads the expressions from the named file");
	puts ("^Wfile	writes all expressions to the named file");
	puts ("	If no file is supplied, then print to the screen");
	}

#define	CTRL_PRINT     16
#define	CTRL_READ      18
#define	CTRL_WRITE     23
#define	CTRL_VAR       22

control (key) char *key;
	{
	int 	var;
	FILE	*saveoutfile;
	switch (*key)
		{
		case CTRL_PRINT: Printequation = !Printequation; return;
		case CTRL_READ: while (iscntrl (*key) || isspace (*key)) key++;
			process (key);
			return;
		case CTRL_WRITE:
		case CTRL_VAR:
			while (*key && (iscntrl (*key) || isspace (*key)))
				key++;
			if (*key)
				{
				fprintf (outfile, "Writing to %s\n", key);
				saveoutfile = outfile;
				if ((outfile = fopen (key, "a")) == NULL)
					{
					fprintf (stderr, "Can't open %s\n", key);
					outfile = saveoutfile;
					}
				}
			for (var = 0; var < Nvar; var++)
				{
				fprintf (outfile, "%-10s = ", Varname[var]);
				if (outfile == stdout)
					{
					if (fzero (answer = eval (Variable[var])))
						answer = 0.0;
					if (answer == UNDEFINED)
						fprintf (outfile, " UNDEFINED = ");
					else
						fprintf (outfile, "%10g = ", answer);
					}
				ptree (outfile, Variable[var]);
				fprintf (outfile, "\n");
				}
			if (*key)
				{
				fclose (outfile);
				outfile = saveoutfile;
				}
			return;
		default: fprintf (stderr, "Unknown control character.\n");
		}
	}

double
eval (expression) ENODE *expression;
	{
	double	tmp1, tmp2;
	if (expression == NULL) return (UNDEFINED);
	if (expression->nodetype == VARIABLE)
		if (Variable[expression->operator])
			return (eval (Variable[expression->operator]));
		else	return (UNDEFINED);
	if (expression->nodetype == NUMBER)
		return (*expression->value);
	if ((tmp2 = eval (expression->right)) == UNDEFINED) return (UNDEFINED);
	switch (expression->operator)
	{
	case '_': return (-tmp2);
	case LOG: if (tmp2 <= FZERO) return (UNDEFINED);
		else return (log (tmp2));
	case COS: return (cos (tmp2));
	case SIN: return (sin (tmp2));
	case TAN: return (tan (tmp2));
	case ACOS: return (acos (tmp2));
	case ASIN: return (asin (tmp2));
	case ATAN: return (atan (tmp2));
	case EXP: return (exp (tmp2));
	case ABS: return (fabs (tmp2));
	case SQRT: if (tmp2 < 0.0) return (UNDEFINED);
		else return (sqrt (tmp2));
	}
	if ((tmp1 = eval (expression->left)) == UNDEFINED) return (UNDEFINED);
	switch (expression->operator)
	{
	case '+': return (tmp1 + tmp2);
	case '-': return (tmp1 - tmp2);
	case '*': return (tmp1 * tmp2);
	case '%': if ((int) tmp2 == 0) return (tmp1);
		else return ((double) (((int) tmp1) % ((int) tmp2)));
	case '/': if (fzero (tmp2)) return (UNDEFINED);
		else return (tmp1/tmp2);
	case '^': return (pow (tmp1, tmp2));
	case '&': return (!fzero (tmp1) && !fzero (tmp2));
	case '|': return (!fzero (tmp1) || !fzero (tmp2));
	case '!': return (fzero (tmp1) ? 1.0 : 0.0);
	case '>': return (tmp1 > tmp2 ? 1.0 : 0.0);
	case '<': return (tmp1 < tmp2 ? 1.0 : 0.0);
	case EQ : return (fzero (tmp1 - tmp2) ? 1.0 : 0.0);
	case NE : return (!fzero (tmp1 - tmp2) ? 1.0 : 0.0);
	case LE : return (tmp1 <= tmp2 ? 1.0 : 0.0);
	case GE : return (tmp1 >= tmp2 ? 1.0 : 0.0);
	case ':': return (0.0); /* dummy return for ? */
	case '?':
		if (expression->right->operator == ':')
			return (!fzero (tmp1)
				? eval (expression->right->left)
				: eval (expression->right->right));
		else if (!fzero (tmp1)) return (eval (expression->right));
		else return (UNDEFINED);
	default: fprintf (stderr, "Unknown operator '%c' = %d\n",
		expression->operator, expression->operator);
		return (UNDEFINED);
	}
	}

ptree (ioptr, expression) ENODE *expression; FILE *ioptr;
	{
	if (expression == NULL)
		return;
	if (expression->nodetype == VARIABLE)
		{
		fprintf (ioptr, "%s", Varname[expression->operator]);
		return;
		}
	else if (expression->nodetype == NUMBER)
		{
		if (*expression->value == UNDEFINED)
			fprintf (ioptr, "UNDEFINED");
		else	fprintf (ioptr, "%g", *expression->value);
		return;
		}
	switch	(expression->operator)
		{
		case LOG: fprintf (ioptr, "log("); break;
		case ABS: fprintf (ioptr, "abs("); break;
		case EXP: fprintf (ioptr, "exp("); break;
		case SQRT: fprintf (ioptr, "sqrt("); break;
		case ATAN: fprintf (ioptr, "atan("); break;
		case ASIN: fprintf (ioptr, "asin("); break;
		case ACOS: fprintf (ioptr, "acos("); break;
		case TAN: fprintf (ioptr, "tan("); break;
		case SIN: fprintf (ioptr, "sin("); break;
		case COS: fprintf (ioptr, "cos("); break;
		case '_' : putc ('-', ioptr);
			ptree (ioptr, expression->right); return;
		case '?':
			fprintf (ioptr, "(if ");
			ptree (ioptr, expression->left);
			fprintf (ioptr, " then ");
			if (expression->right->operator == ':')
				{
				ptree (ioptr, expression->right->left);
				fprintf (ioptr, " else ");
				ptree (ioptr, expression->right->right);
				}
			else ptree (ioptr, expression->right);
			putc (')', ioptr);
			return;
		default: putc ('(', ioptr);
			ptree (ioptr, expression->left);
			switch (expression->operator)
				{
				case EQ: fprintf (ioptr, " == "); break;
				case NE: fprintf (ioptr, " != "); break;
				case GE: fprintf (ioptr, " >= "); break;
				case LE: fprintf (ioptr, " <= "); break;
				default: fprintf (ioptr, " %c ",expression->operator);
				}
		}
	ptree (ioptr, expression->right);
	putc (')', ioptr);
	}

/* Suzanne Shouman fixed a bug here. Thanks */
begins (s1, s2) char *s1, *s2;
	{
	int 	alphlag = isvarchar (*s1);
	while (*s1)
		if (*s1++ != *s2++) return (0);
	return (alphlag ? !isvarchar(*s2) : 1);
	}

checkrecursion (varno, expr)
int 	varno;      /* look for recursion involving this variable */
ENODE	*expr;      /* look for recursion of varno in this expr */
	{
	if (expr == NULL) return (0);
	if (expr->nodetype == VARIABLE)
		{
		if (expr->operator == varno) return (1);
		if (checkrecursion (varno, Variable[expr->operator])) return (1);
		}
	return
		(
		checkrecursion (varno, expr->left)
		||
		checkrecursion (varno, expr->right)
		);
	}

char *
getline (line, ioptr) char *line; FILE *ioptr;
	{
	register int C;
	register char *lptr = line;
	while ((C = getc (ioptr)) != '\n' && C != ';' && C != EOF)
		*lptr++ = C;
	if (C == EOF) return (NULL);
	while (C != '\n' && C != EOF) C = getc (ioptr);
	*lptr = '\0';
	return (line);
	}

errorexit (string) char *string;
	{
	fprintf (stderr, "%s\n", string);
	control ("\027calc.save");
	fprintf (stderr, "Current state saved in calc.save\n");
	exit (1);
	}