/************************************************************************/
/*                                                                      */
/* Copyright (c) 1988 -                                                 */
/*     The Rector and Visitors of the University of Virginia            */
/*                                                                      */
/* This code may not be distributed further without permission          */
/*      from the University of Virginia.                                */
/* This code is distributed WITHOUT ANY WARRANTY.  No claims are        */
/*      made as to whether it serves any particular purpose or even     */
/*      works at all.                                                   */
/*                                                                      */
/************************************************************************/

#include <stdio.h>
#include <string.h>
#include "types.h"
#include "size.h"
#include "tword.h"
#include "scan.h"
#include "stopset.h"
#include "object.h"
#include "node.h"
#include "ident.h"
#include "error.h"
#include "../rt/runtime.h"

/*
 * expression = simple-expression { relational-operator simple-expression } .
 *
 * relational-operator = "<" | "<=" | "=" | "<>" | ">=" | ">" | "in" .
 */

OBJECT *
p_expression (node, stop)
	register NODE **node;
	STOPSET stop;
{
	STOPBUF mystop1, mystop2;
	register OBJECT *tleft, *tright;
	NODE *nright;
	register int op;

	/* build parse tree for relational operator expression */

	set_or(mystop1, stop, rel_op, S0);
	tleft = p_simple_expr(node, mystop1);
	set_or(mystop2, stop, expr_begin, S0);
	while(set_in(symbol, rel_op)) {
		op = symbol;
		p_expect(symbol, mystop2);
		tright = p_simple_expr(&nright, mystop1);
		tleft = p_binop(op, node, nright, tleft, tright);
	}
	p_check(stop);
	if (tleft == std_universal) {  /* error recovery */
		nd_freetree(*node);
		*node = nd_label(0);  /* a fairly inert node */
	}
	return(tleft);
}

/*
 * simple-expression = [ + | - ] term { add-operator term } .
 *
 * add-operator = "+" | "-" | "or"
 */

OBJECT *
p_simple_expr(node, stop)
	register NODE **node;
	STOPSET stop;
{
	STOPBUF mystop1, mystop2;
	register OBJECT *tleft, *tright;
	NODE *nright;
	int op, sign = 0;

	/* build parse tree for adding operator expression */

	set_or(mystop1, stop, term_begin, add_op, S0);
	p_check(mystop1);
	set_or(mystop2, stop, term_begin, S0);
	if (symbol == SY_PLUS || symbol == SY_MINUS) {
		sign = symbol;
		p_expect(symbol, mystop2);
	}
	set_or(mystop1, stop, add_op, S0);
	tleft = p_term(node, mystop1);
	if (sign && (tleft == std_real || tleft == std_integer)) {
		if (sign == SY_MINUS)
			*node = nd_build(ND_UMINUS, tleft->ob_tword, *node, ND_NULL);
	}
	else if (sign && tleft != std_universal) {
		sprintf(err_text, err_unop, err_symbol[sign]);
		err_msg(E_FATAL, E_PREVSYMBOL);
		tleft = std_universal;
	}
	while(set_in(symbol, add_op)) {
		op = symbol;
		p_expect(symbol, mystop2);
		tright = p_term(&nright, mystop1);
		tleft = p_binop(op, node, nright, tleft, tright);
	}
	p_check(stop);
	return(tleft);
}

/*
 * term = factor { mul-operator factor } .
 *
 * mul-operator = "*" | "/" | "and" | "div" | "mod" .
 */

OBJECT *
p_term(node, stop)
	register NODE **node;
	STOPSET stop;
{
	STOPBUF mystop1, mystop2;
	register OBJECT *tleft, *tright;
	NODE *nright;
	int op;

	/* build parse tree for multiplying operator expression */

	set_or(mystop1, stop, mul_op, S0);
	tleft = p_factor(node, mystop1);
	set_or(mystop2, stop, factor_begin, S0);
	while (set_in(symbol, mul_op)) {
		op = symbol;
		p_expect(symbol, mystop2);
		tright = p_factor(&nright, mystop1);
		tleft = p_binop(op, node, nright, tleft, tright);
	}
	p_check(stop);
	return(tleft);
}

/*
 * factor = function-call | unsigned-constant | variable-access |
 *		"nil" | set-constructor | "(" expression ")" | "not" factor .
 */

OBJECT *
p_factor(node, stop)
	register NODE **node;
	STOPSET stop;
{
	STOPBUF mystop;
	register OBJECT *factor;

	switch (symbol) {

	case SY_IDENT:
		if (factor = ob_searchall(ident_in)) {
			switch (factor->ob_kind) {
			case OB_FUNC:
				return(p_func_call(node, stop));  /* call function */
			case OB_CONST:
				factor = p_constant(ID_NULL, stop);  /* constant */
				*node = nd_const(factor);
				return(factor->ob_type);
			}
		}
		factor = p_var_access(node, VA_EXPR, stop);  /* variable-access */

		/*
		 * nodes from p_var_access are always addresses.  If this a
		 * simple type, we must dereference to get the value.
		 */

		if (OB_ISSIMPLE(factor->ob_kind))
			*node = nd_build(ND_DEREF, factor->ob_tword, *node, ND_NULL);
		return(factor);
			
	case SY_NIL:
		p_expect(SY_NIL, stop);
		*node = nd_icon(0, TW_PTR+TW_UNDEF);
		return(std_nil);

	case SY_LBRAC:
		return(p_set_cons(node, stop));  /* set constructor */

	case SY_LPAREN:
		set_or(mystop, stop, expr_begin, set_cons(SY_RPAREN, 0), S0);
		p_expect(SY_LPAREN, mystop);
		set_or(mystop, stop, set_cons(SY_RPAREN, 0), S0);
		factor = p_expression(node, mystop);
		p_expect(SY_RPAREN, stop);
		return(factor);

	case SY_NOT:
		set_or(mystop, stop, factor_begin, S0);
		p_expect(SY_NOT, mystop);
		factor = p_factor(node, stop);
		if (!OB_SAMETYPE(factor, std_boolean)) {
			sprintf(err_text, err_boole, "not");
			err_msg(E_FATAL, E_PREVSYMBOL);
			factor = std_universal;
		}
		*node = nd_build(SY_NOT, TW_INT, *node, ND_NULL);
		return(factor);

	case SY_PLUS:	/* factors have only unsigned constants */
	case SY_MINUS:
		break;

	default:
		if (set_in(symbol, const_begin)) {
			factor = p_constant(ID_NULL, stop);
			*node = nd_const(factor);
			return(factor->ob_type);
		}
	}

	/* error recovery -- can't leave *node undefined */

	p_error(0, stop);
	*node = nd_label(0);
	return(std_universal);
}

/*
 * function-call = identifier actual-parameter-list .
 */

OBJECT *
p_func_call(node, stop)
	register NODE **node;
	STOPSET stop;
{
	STOPBUF mystop;
	register OBJECT *func;
	register NODE *pnode;

	set_or(mystop, stop, set_cons(SY_LPAREN, 0), S0);
	func = ob_searchall(p_expectident(mystop));
	ob_keepoff(func);
	if (func->ob.subp.standard)
		return(p_std_func(node, func, stop));
	func->ob_flags |= OB_USED;
	pnode = p_ap_list(func, stop);
	*node = nd_build(ND_CALL, func->ob_type->ob_tword,
		nd_address(func), pnode);

	/* do not return subrange type */

	if (func->ob_type->ob_kind == OB_SUBRANGE)
		return(func->ob_type->ob_type);
	return(func->ob_type);
}

/*
 * set-constructor = "[" [ member { "," member } ] "]" .
 */

OBJECT *
p_set_cons(node, stop)
	register NODE **node;
	STOPSET stop;
{
	STOPBUF mystop1, mystop2;
	register OBJECT *stype, *mtype, *set;
	NODE *node2, *runtime;

	/*
	 * set operations are handled in the run time system.
	 * Start out by emitting a call to RT_set_init to initialize
	 * the set to the null set and then add in the members in
	 * the set-constructor by emitting calls to RT_set_member
	 * and RT_set_range.  We must mark the set type as a
	 * constructed set to that it will be compatible with
	 * both packed and unpacked set types. 
	 */

	set_or(mystop1, stop, expr_begin, set_cons(SY_COMMA, SY_RBRAC, 0), S0);
	p_expect(SY_LBRAC, mystop1);
	stype = ob_define(ID_NULL, OB_SET, OB_SETCONS);
	stype->ob_type = std_universal;
	stype->ob_tword = TW_STRTY;
	stype->ob_size = sizeof(SET);

	/* we need a temporary variable to store the set */

	set = ob_tmpvar(TW_STRTY, sizeof(SET), OB_VARIABLE);
	set->ob_flags = OB_FREETMP;
	*node = nd_build(ND_CALL, TW_PTR+TW_STRTY,
		nd_runtime("RT_set_init", TW_PTR+TW_STRTY), nd_address(set));
	set = stype;
	if (symbol != SY_RBRAC) {
		set_or(mystop1, stop, set_cons(SY_COMMA, SY_RBRAC, 0), S0);
		set_or(mystop2, stop, expr_begin, set_cons(SY_RBRAC, 0), S0);
		for (;;) {
			mtype = p_member(&node2, mystop1);
			if (!OB_SAMETYPE(stype->ob_type, mtype)) {
				strcpy(err_text, err_setmemb);
				err_msg(E_FATAL, E_PREVSYMBOL);
				set = std_universal;
			}
			stype->ob_type = mtype;
			if (mtype == std_universal)
				set = std_universal;
			runtime = nd_runtime (node2->nd_op == SY_COMMA ?
				"RT_set_range" : "RT_set_member", TW_PTR+TW_STRTY);
			node2 = nd_build(SY_COMMA, TW_UNDEF, node2, *node);
			*node = nd_build(ND_CALL, TW_PTR+TW_STRTY, runtime, node2);
			if (symbol != SY_COMMA)
				break;
			p_expect(SY_COMMA, mystop2);
		}
	}
	p_expect(SY_RBRAC, stop);
	return(set);
}

/*
 * member = expression [ ".." expression ] .
 */

OBJECT *
p_member(node, stop)
	register NODE **node;
	STOPSET stop;
{
	STOPBUF mystop;
	register OBJECT *e1, *e2;
	NODE *node2;

	set_or(mystop, stop, set_cons(SY_DOTDOT, 0), S0);
	e1 = p_expression(node, mystop);
	if (!OB_ISORDINAL(e1)) {
		sprintf(err_text, err_ord, "set member");
		err_msg(E_FATAL, E_PREVSYMBOL);
		e1 = std_universal;
	}
	*node = nd_build(ND_SCONV, TW_INT, *node, ND_NULL);
	if (symbol == SY_DOTDOT) {
		set_or(mystop, stop, expr_begin, S0);
		p_expect(SY_DOTDOT, mystop);
		e2 = p_expression(&node2, stop);
		if (!OB_SAMETYPE(e1, e2)) {
			strcpy(err_text, err_setmemb);
			err_msg(E_FATAL, E_PREVSYMBOL);
			e1 = std_universal;
		}
		if (e2 == std_universal)
			e1 = std_universal;
		node2 = nd_build(ND_SCONV, TW_INT, node2, ND_NULL);
		*node = nd_build(SY_COMMA, TW_UNDEF, *node, node2);
	}
	else {
		p_check(stop);
	}
	return(e1);
}

/*
 * p_binop checks the compatiblity of the operands with the operator
 * and builds the expression tree.  returns type of new expression
 * and leaves pointer to new tree in *nleft.
 */

OBJECT *
p_binop(op, nleft, nright, tleft, tright)
	int op;
	register NODE **nleft, *nright;
	register OBJECT *tleft, *tright;
{
	register OBJECT *ret, *set;
	register TWORD tword;

	/* std_universal indicates an error-- save some work */

	if (tleft == std_universal || tright == std_universal) {
		nd_freetree(nright);
		return(std_universal);
	}

	/*
	 * coerce integer expressions to real if either operand is
	 * real or if we are using the "/" operator
	 */
	if (set_in(op, real_op) && (tleft == std_real ||
		tright == std_real || op == SY_SLASH))
	{
		if (tleft == std_integer) {
			tleft = std_real;
			*nleft = nd_build(ND_SCONV, TW_DOUBLE, *nleft, ND_NULL);
		}
		if (tright == std_integer) {
			tright = std_real;
			nright = nd_build(ND_SCONV, TW_DOUBLE, nright, ND_NULL);
		}
	}
	/*
	 * if the two types are incompatible look for "in" operator
	 */
	if (!ck_compatible(tleft, tright)) {
		if (op == SY_IN && OB_ISORDINAL(tleft) &&
			tright->ob_kind == OB_SET &&
			ck_compatible(tleft, tright->ob_type))
		{
			/*
			 * call run time function for "in" operator.
			 */
			nright = nd_build(SY_COMMA, TW_UNDEF, *nleft, nright);
			*nleft = nd_build(ND_CALL, TW_INT,
				nd_runtime("RT_set_in", TW_INT), nright);
			return (std_boolean);
		}
		goto err;
	}

	/* determine type of expression */

	if (set_in(op, rel_op))
		ret = std_boolean;
	else if (tleft->ob_kind == OB_SET && tleft->ob_flags & OB_SETCONS)
		ret = tright;
	else 
		ret = tleft;
	tword = ret->ob_tword;

	switch(tleft->ob_kind) {

	case OB_STDTYPE:
		if ((tleft == std_integer && set_in(op, int_op))  ||
			(tleft == std_boolean && set_in(op, boole_op))||
			(tleft == std_real    && set_in(op, real_op)) ||
			(tleft == std_char    && set_in(op, char_op)))
		{
			*nleft = nd_build(op, tword, *nleft, nright);
			return(ret);
		}
		break;

	case OB_ARRAY:
		if (ck_string(tleft) && set_in(op, char_op)) {
			/*
			 * string comparison:  call run time string comparison
			 * function and compare result with zero.
			 */
			nright = nd_build(SY_COMMA, TW_UNDEF, *nleft, nright);
			nright = nd_build(SY_COMMA, TW_UNDEF, nright,
				nd_icon(tleft->ob.array.upper, TW_INT));
			nright = nd_build(ND_CALL, TW_INT,
				nd_runtime("RT_str_cmp", TW_INT), nright);
			*nleft = nd_build(op, tword, nright, nd_icon(0, TW_INT));
			return(ret);
		}
		break;

	case OB_POINTER:
		if (set_in(op, point_op)) {
			*nleft = nd_build(op, tword, *nleft, nright);
			return(ret);
		}
		break;

	case OB_SET:
		if (!set_in(op, set_op))
			break;
		if (set_in(op, rel_op)) {
			/*
			 * set comparison: call run time set comparison function
			 */
			*nleft = nd_build(SY_COMMA, TW_UNDEF,
				nd_icon(op, TW_INT), *nleft);
			nright = nd_build(SY_COMMA, TW_UNDEF, *nleft, nright);
			*nleft = nd_build(ND_CALL, TW_INT,
				nd_runtime("RT_set_cmp", TW_INT), nright);
		}
		else {
			/*
			 * set arithmetic done by run time function.
			 */
			set = ob_tmpvar(TW_STRTY, sizeof(SET), OB_VARIABLE);
			set->ob_flags = OB_FREETMP;
			*nleft = nd_build(SY_COMMA, TW_UNDEF,
				nd_icon(op, TW_INT), *nleft);
			nright = nd_build(SY_COMMA, TW_UNDEF, *nleft, nright);
			nright = nd_build(SY_COMMA, TW_UNDEF, nright, nd_address(set));
			*nleft = nd_build(ND_CALL, TW_PTR+TW_STRTY,
				nd_runtime("RT_set_binop", TW_PTR+TW_STRTY), nright);
		}
		return(ret);

	case OB_ENUMER:
		if (set_in(op, char_op)) {
			*nleft = nd_build(op, tword, *nleft, nright);
			return(ret);
		}
		break;
	}
err:
	sprintf(err_text, "illegal/incompatible operands for operator %s",
		err_symbol[op]);
	err_msg(E_FATAL, E_PREVSYMBOL);
	nd_freetree(nright);
	return(std_universal);
}
