デカルト言語 - 並列ロジック プログラミング言語

/*
 * expression program copyright (C) 2009 - 2012 H.Niwa
 */

/*
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.

 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.

 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301, USA.
 */

#include "config.h"

#include <stdio.h>
#include <stdlib.h>
#include <errno.h>

#include <string>
#include <complex>

#include "syserr.h"

#include "bin_node.h"
#include "gc.h"
#include "var.h"
#include "pred.h"
#include "context.h"
#include "unify.h"
#include "builtin.h"
#include "sysmodule.h"
#include "func.h"
#include "let.h"
#include "expression.h"

int Expressioni(Context* cx, Node* &exp);
int Exp_PlsMnsi(Context* cx, Node* &exp);
int Exp_MulDivi(Context* cx, Node* &exp);
int Exp_Termi(Context* cx, Node* &exp);

int Expressionf(Context* cx, Node* &exp);
int Exp_PlsMnsf(Context* cx, Node* &exp);
int Exp_MulDivf(Context* cx, Node* &exp);
int Exp_Termf(Context* cx, Node* &exp);

int ExpressionC(Context* cx, Node* &exp);
int Exp_PlsMnsC(Context* cx, Node* &exp);
int Exp_MulDivC(Context* cx, Node* &exp);
int Exp_TermC(Context* cx, Node* &exp);

int Comparingi(Context* cx, Node* &exp);
int Comp_Ori(Context* cx, Node* &exp);
int Comp_Andi(Context* cx, Node* &exp);
int Comp_Noti(Context* cx, Node* &exp);
int Comp_GLi(Context* cx, Node* &exp);

int Comparingf(Context* cx, Node* &exp);
int Comp_Orf(Context* cx, Node* &exp);
int Comp_Andf(Context* cx, Node* &exp);
int Comp_Notf(Context* cx, Node* &exp);
int Comp_GLf(Context* cx, Node* &exp);

int ComparingC(Context* cx, Node* &exp);
int Comp_OrC(Context* cx, Node* &exp);
int Comp_AndC(Context* cx, Node* &exp);
int Comp_NotC(Context* cx, Node* &exp);
int Comp_GLC(Context* cx, Node* &exp);


/* -----------------------------------------------*/

int Expressioni(Context* cx, Node* &exp)
{
	int	rn;
	
	if (!((rn=Exp_PlsMnsi(cx, exp))>0)) {
		return rn;
	}
	return 1;	
}


int Exp_PlsMnsi(Context* cx, Node* &exp)
{
	Node* expsave = exp;
	int rn;
	if (!((rn=Exp_MulDivi(cx, exp))>0)) {
		return rn;
	}
	while (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("+")) {
				exp = exp->Cdr();

				if (!((rn=Exp_MulDivi(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				int_plus(cx);
			} else if (((Atom*)exp->Car())->EqStr("-")) {
				exp = exp->Cdr();

				if (!((rn=Exp_MulDivi(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				int_minus(cx);
			} else {
				return 1;
			}
		} else {
			syslist(exp);
			syserr("illegal atom");
			return 0;
		}
	}

	return 1;
}

int Exp_MulDivi(Context* cx, Node* &exp)
{
	Node* expsave = exp;
	int	rn;
	
	if (!((rn=Exp_Termi(cx, exp))>0)) {
		return rn;
	}
	while (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("*")) {
				exp = exp->Cdr();

				if (!((rn=Exp_Termi(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				int_mult(cx);
			} else if (((Atom*)exp->Car())->EqStr("/")) {
				exp = exp->Cdr();

				if (!((rn=Exp_Termi(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				int_div(cx);
			} else if (((Atom*)exp->Car())->EqStr("%")) {
				exp = exp->Cdr();

				if (!((rn=Exp_Termi(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				int_mod(cx);
			} else {
				return 1;
			}
		} else {
			syslist(exp);
			syserr("illegal atom");
			return 0;
		}
	}
	return 1;
}


int Exp_Termi(Context* cx, Node* &exp)
{
	long long r;
	long double	rf;
	Node* expsave = exp;
	int	rn;
	
	Node* expbr = exp->Car()->Val();
//	Node* expbr = exp->Car();
	if (expbr->kind() == LIST) {
		if ((rn=Expressioni(cx, expbr))>0) {
			exp = exp->Cdr();
			return 1;
		} else {
			exp = expsave;
			return rn;
		}
	} else if (expbr->kind() == ATOM) {
		if (((Atom*)expbr)->toInt(r)) {
			exp = exp->Cdr();
			int_pushnum(cx, r);
			return 1;
		} else if (((Atom*)expbr)->toFloat(rf)) {
			exp = exp->Cdr();
			int_pushnum(cx, (int)rf);
			return 1;
		} else {
			exp = expsave;
			syserr("not a number\n");
			return 0;
		}
	} else if (expbr->kind() == PRED) {
		Node*	 rval;
		Context* cx2 = new Context(cx->module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		cxpush(cx, expbr);
//		if ((rn=Unify(cx2, expbr, cx->module))>0) {
		if ((rn=FuncPred(cx2, expbr, cx->module, rval))>0) {
			cxpop(cx);

			cx->Merge(cx2);
			delete cx2;
			cx2 = 0;
			
//printf("expression "); exp->print(); printf("\n");

			rval = rval->Val();
//printf("return value %d  ", rval->kind()); rval->print(); printf("\n");
			if (rval->kind() != ATOM) {
				exp = expsave;
				syslist(exp);
				syserr("not a return number");
				return 0;
			}

//printf("Exp_Termi 2 expbr int_pushnum "); expbr->print(); printf("\n");
			if (((Atom*)rval)->toInt(r)) {
				exp = exp->Cdr();
				int_pushnum(cx, r);

				return 1;
			} else if (((Atom*)rval)->toFloat(rf)) {
				exp = exp->Cdr();
				int_pushnum(cx, (long long)rf);

				return 1;
			} else {
				exp = expsave;
				syserr("not a number\n");
				return 0;
			}
		} else {
			cxpop(cx);
			delete cx2;
			cx2 = 0;
			syserr("Evaluation of an argument failed\n");
			return 0;
		}
	} else if (expbr->kind() == UNDEF) {
		syserr("variable does not have a value\n");
		exp = expsave;
		return 0;
	}

	exp = expsave;
	syslist(exp);
	syserr("illegal expression (Exp_Termi)");

	return 0;
}

/* -----------------------------------------------*/


int Expressionf(Context* cx, Node* &exp)
{
	int	rn;
	
	if (!((rn=Exp_PlsMnsf(cx, exp))>0)) {
		return rn;
	}
	return 1;	
}


int Exp_PlsMnsf(Context* cx, Node* &exp)
{
	Node* expsave = exp;
	int rn;
	if (!((rn=Exp_MulDivf(cx, exp))>0)) {
		return rn;
	}
	while (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("+")) {
				exp = exp->Cdr();

				if (!((rn=Exp_MulDivf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				float_plus(cx);
			} else if (((Atom*)exp->Car())->EqStr("-")) {
				exp = exp->Cdr();

				if (!((rn=Exp_MulDivf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				float_minus(cx);
			} else {
				return 1;
			}
		} else {
			syslist(exp);
			syserr("illegal atom");
			return 0;
		}
	}

	return 1;
}

int Exp_MulDivf(Context* cx, Node* &exp)
{
	Node* expsave = exp;
	int	rn;
	
	if (!((rn=Exp_Termf(cx, exp))>0)) {
		return rn;
	}
	while (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("*")) {
				exp = exp->Cdr();

				if (!((rn=Exp_Termf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				float_mult(cx);
			} else if (((Atom*)exp->Car())->EqStr("/")) {
				exp = exp->Cdr();

				if (!((rn=Exp_Termf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				float_div(cx);
			} else if (((Atom*)exp->Car())->EqStr("%")) {
				exp = exp->Cdr();

				if (!((rn=Exp_Termf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				float_mod(cx);
			} else {
				return 1;
			}
		} else {
			syslist(exp);
			syserr("illegal atom");
			return 0;
		}
	}
	return 1;
}


int Exp_Termf(Context* cx, Node* &exp)
{
	long double	r;
	Node* expsave = exp;
	int	rn;
	
	Node* expbr = exp->Car()->Val();
	if (expbr->kind() == LIST) {
		if ((rn=Expressionf(cx, expbr))>0) {
			exp = exp->Cdr();
			return 1;
		} else {
			exp = expsave;
			return rn;
		}
	} else if (expbr->kind() == ATOM) {
//printf("Exp_Term 1 expbr float_pushnum "); expbr->print(); printf("\n");
		if (((Atom*)expbr)->toFloat(r)) {
			exp = exp->Cdr();
//printf("Exp_Term 1 %g \n", r);fflush(stdout);
			float_pushnum(cx, r);
			return 1;
		} else {
			exp = expsave;
			syserr("not a number\n");
			return 0;
		}
	} else if (expbr->kind() == PRED) {
		Node*	 rval;
		Context* cx2 = new Context(cx->module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		cxpush(cx, expbr);
//		if ((rn=Unify(cx2, expbr, cx->module))>0) {
		if ((rn=FuncPred(cx2, expbr, cx->module, rval))>0) {
			cxpop(cx);

			cx->Merge(cx2);
			delete cx2;
			cx2 = 0;
			
//printf("expression "); exp->print(); printf("\n");

			rval = rval->Val();
//printf("return value %d  ", rval->kind()); rval->print(); printf("\n");
			if (rval->kind() != ATOM) {
				exp = expsave;
				syslist(exp);
				syserr("not a return number");
				return 0;
			}

//printf("Exp_Term 2 expbr float_pushnum "); expbr->print(); printf("\n");
			if (((Atom*)rval)->toFloat(r)) {
				exp = exp->Cdr();
//printf("Exp_Term 3 %g \n", r);fflush(stdout);
				float_pushnum(cx, r);
//printf("cx->env_stack "); cx->env_stack->print(); printf("\n");

				return 1;
			} else {
				exp = expsave;
				syserr("not a number\n");
				return 0;
			}

		} else {
			cxpop(cx);
			delete cx2;
			cx2 = 0;
			syserr("Evaluation of an argument failed\n");
			return 0;
		}
	} else if (expbr->kind() == UNDEF) {
		syserr("variable does not have a value\n");
		exp = expsave;
		return 0;
	}

	exp = expsave;
	syslist(exp);
	syserr("illegal expression (Exp_Term)");
	return 0;
}

/* -----------------------------------------------*/


int ExpressionC(Context* cx, Node* &exp)
{
	int	rn;
	
	if (!((rn=Exp_PlsMnsC(cx, exp))>0)) {
		return rn;
	}
	return 1;	
}


int Exp_PlsMnsC(Context* cx, Node* &exp)
{
	Node* expsave = exp;
	int rn;
	if (!((rn=Exp_MulDivC(cx, exp))>0)) {
		return rn;
	}
	while (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("+")) {
				exp = exp->Cdr();

				if (!((rn=Exp_MulDivC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				complex_plus(cx);
			} else if (((Atom*)exp->Car())->EqStr("-")) {
				exp = exp->Cdr();

				if (!((rn=Exp_MulDivC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				complex_minus(cx);
			} else {
				return 1;
			}
		} else {
			syslist(exp);
			syserr("illegal atom");
			return 0;
		}
	}

	return 1;
}

int Exp_MulDivC(Context* cx, Node* &exp)
{
	Node* expsave = exp;
	int	rn;
	
	if (!((rn=Exp_TermC(cx, exp))>0)) {
		return rn;
	}
	while (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("*")) {
				exp = exp->Cdr();

				if (!((rn=Exp_TermC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				complex_mult(cx);
			} else if (((Atom*)exp->Car())->EqStr("/")) {
				exp = exp->Cdr();

				if (!((rn=Exp_TermC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				complex_div(cx);
#if 0
			} else if (((Atom*)exp->Car())->EqStr("%")) {
				exp = exp->Cdr();

				if (!((rn=Exp_TermC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				complex_mod(cx);
#endif
			} else {
				return 1;
			}
		} else {
			syslist(exp);
			syserr("illegal atom");
			return 0;
		}
	}
	return 1;
}


int Exp_TermC(Context* cx, Node* &exp)
{
	std::complex<long double>	c;
	Node* expsave = exp;
	int	rn;
	
	Node* expbr = exp->Car()->Val();
	if (expbr->kind() == LIST) {
		if ((rn=ExpressionC(cx, expbr))>0) {
			exp = exp->Cdr();
			return 1;
		} else {
			exp = expsave;
			return rn;
		}
	} else if (expbr->kind() == ATOM) {
//printf("Exp_Term 1 expbr complex_pushnum "); expbr->print(); printf("\n");
		if (((Atom*)expbr)->toComplex(c)) {
			exp = exp->Cdr();
//printf("Exp_Term 1 %g \n", r);fflush(stdout);
			complex_pushnum(cx, c);
			return 1;
		} else {
			exp = expsave;
			syserr("not a number\n");
			return 0;
		}
	} else if (expbr->kind() == PRED) {
		Node*	 rval;
		Context* cx2 = new Context(cx->module, cx->modulename);
		cx2->selfname = cx->selfname;
		cx2->ioin = cx->ioin;
		cx2->ioout = cx->ioout;
		cx2->tokenflag = cx->tokenflag;
		cx2->token = cx->token;

		cx2->ode = cx->ode;
		cx2->integral = cx->integral;

		cxpush(cx, expbr);
//		if ((rn=Unify(cx2, expbr, cx->module))>0) {
		if ((rn=FuncPred(cx2, expbr, cx->module, rval))>0) {
			cxpop(cx);

			cx->Merge(cx2);
			delete cx2;
			cx2 = 0;
			
//printf("expression "); exp->print(); printf("\n");

			rval = rval->Val();
//printf("return value %d  ", rval->kind()); rval->print(); printf("\n");
			if (rval->kind() != ATOM) {
				exp = expsave;
				syslist(exp);
				syserr("not a return number");
				return 0;
			}

//printf("Exp_Term 2 expbr complex_pushnum "); expbr->print(); printf("\n");
			if (((Atom*)rval)->toComplex(c)) {
				exp = exp->Cdr();
//printf("Exp_Term 3 %g \n", r);fflush(stdout);
				complex_pushnum(cx, c);
//printf("cx->env_stack "); cx->env_stack->print(); printf("\n");

				return 1;
			} else {
				exp = expsave;
				syserr("not a complex number\n");
				return 0;
			}

		} else {
			cxpop(cx);
			delete cx2;
			cx2 = 0;
			syserr("Evaluation of an argument failed\n");
			return 0;
		}
	} else if (expbr->kind() == UNDEF) {
		syserr("variable does not have a value\n");
		exp = expsave;
		return 0;
	}

	exp = expsave;
	syslist(exp);
	syserr("illegal expression (Exp_Term)");
	return 0;
}


/* -----------------------------------------------*/


int Comparingi(Context* cx, Node* &exp)
{
//printf("Comparingi "); exp->print(); printf("\n");
	int	rn;
	
	if (!((rn=Comp_Ori(cx, exp))>0)) {
		return rn;
	}
	return 1;	
}

int Comp_Ori(Context* cx, Node* &exp)
{
//printf("Comp or "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	rn=Comp_Andi(cx, exp);

	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("or")) {
				exp = exp->Cdr();

				rn=Comp_Andi(cx, exp);
				if (int_or(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_or \n");
				}
			} else {
				return 1;
			}
		} else {
			return -1;
		}
	}

	return 1;
}

int Comp_Andi(Context* cx, Node* &exp)
{
//printf("Comp and "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (!((rn=Comp_Noti(cx, exp))>0)) {
		return rn;
	}
	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("and")) {
				exp = exp->Cdr();

				rn=Comp_Noti(cx, exp);
				if (int_and(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_and \n");
				}
			} else {
				return 1;
			}
		} else {
			return -1;
		}
	}

	return 1;
}

int Comp_Noti(Context* cx, Node* &exp)
{
//printf("Comp not "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("not")) {
				exp = exp->Cdr();

				rn=Comp_GLi(cx, exp);
				exp = exp->Cdr();

				if (int_not(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_not \n");
				}
			} 
		}
	}

	if (!((rn=Comp_GLi(cx, exp))>0)) {
		exp = expsave;
		return rn;
	}

	return 1;
}

int Comp_GLi(Context* cx, Node* &exp)
{
//printf("Comp gl "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (exp->Car()->kind() == LIST) {
		Node* expbr = exp->Car();
		if ((rn=Comparingi(cx, expbr))>0) {
			exp = exp->Cdr();
			return 1;
		} else {
			exp = expsave;
			return rn;
		}
	}


	if (!((rn=Expressioni(cx, exp))>0)) {
		return rn;
	}
	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("==") ||
			    ((Atom*)exp->Car())->EqStr("=" )) {
				exp = exp->Cdr();

				if (!((rn=Expressioni(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (int_eq(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_eq \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<>") ||
			           ((Atom*)exp->Car())->EqStr("!=") ) {
				exp = exp->Cdr();

				if (!((rn=Expressioni(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (int_noteq(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_noteq \n");
				}
			} else if (((Atom*)exp->Car())->EqStr(">=") ) {
				exp = exp->Cdr();

				if (!((rn=Expressioni(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (int_ge(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_ge \n");
				}
			} else if (((Atom*)exp->Car())->EqStr(">") ) {
				exp = exp->Cdr();

				if (!((rn=Expressioni(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (int_gt(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_gt \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<=") ) {
				exp = exp->Cdr();

				if (!((rn=Expressioni(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (int_le(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_le \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<") ) {
				exp = exp->Cdr();

				if (!((rn=Expressioni(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (int_lt(cx)) {
					if (cx->int_stack[cx->int_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("int_lt \n");
				}
			} else {
				return 1;
			}
		} else {
			return 0;
		}
	}

	return 1;
}

/* -----------------------------------------------*/

int Comparingf(Context* cx, Node* &exp)
{
//printf("Comparing "); exp->print(); printf("\n");
	int	rn;
	
	if (!((rn=Comp_Orf(cx, exp))>0)) {
		return rn;
	}
	return 1;	
}

int Comp_Orf(Context* cx, Node* &exp)
{
//printf("Comp or "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	rn=Comp_Andf(cx, exp);

	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("or")) {
				exp = exp->Cdr();

				rn=Comp_Andf(cx, exp);
				if (float_or(cx)) {
					if (cx->float_stack[cx->float_stackp-1] != 0.0) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_or \n");
				}
			} else {
				return 1;
			}
		} else {
			return 0;
		}
	}

	return 1;
}

int Comp_Andf(Context* cx, Node* &exp)
{
//printf("Comp and "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (!((rn=Comp_Notf(cx, exp))>0)) {
		return rn;
	}

	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("and")) {
				exp = exp->Cdr();

				rn=Comp_Notf(cx, exp);
				if (float_and(cx)) {
					if (cx->float_stack[cx->float_stackp-1] != 0.0) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_and \n");
				}
			} else {
				return 1;
			}
		} else {
			return 0;
		}
	}

	return 1;
}

int Comp_Notf(Context* cx, Node* &exp)
{
//printf("Comp not "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("not")) {
				exp = exp->Cdr();

				rn=Comp_GLf(cx, exp);
				exp = exp->Cdr();

				if (float_not(cx)) {
					if (cx->float_stack[cx->float_stackp-1] != 0.0) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_not \n");
				}
			} 
		}
	}

	if (!Comp_GLf(cx, exp)) {
		exp = expsave;
		return -1;
	}

	return 1;
}

int Comp_GLf(Context* cx, Node* &exp)
{
//printf("Comp gl "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (exp->Car()->kind() == LIST) {
		Node* expbr = exp->Car();
		if ((rn=Comparingf(cx, expbr))>0) {
			exp = exp->Cdr();
			return 1;
		} else {
			exp = expsave;
			return rn;
		}
	}


	if (!((rn=Expressionf(cx, exp))>0)) {
		return rn;
	}
	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("=") ||
			    ((Atom*)exp->Car())->EqStr("==")) {
				exp = exp->Cdr();

				if (!((rn=Expressionf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (float_eq(cx)) {
					if (cx->float_stack[cx->float_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_eq \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<>") ||
			           ((Atom*)exp->Car())->EqStr("!=")) {
				exp = exp->Cdr();

				if (!((rn=Expressionf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (float_noteq(cx)) {
					if (cx->float_stack[cx->float_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_noteq \n");
				}
			} else if (((Atom*)exp->Car())->EqStr(">=") ) {
				exp = exp->Cdr();

				if (!((rn=Expressionf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (float_ge(cx)) {
					if (cx->float_stack[cx->float_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_ge \n");
				}
			} else if (((Atom*)exp->Car())->EqStr(">") ) {
				exp = exp->Cdr();

				if (!((rn=Expressionf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (float_gt(cx)) {
					if (cx->float_stack[cx->float_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_gt \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<=") ) {
				exp = exp->Cdr();

				if (!((rn=Expressionf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (float_le(cx)) {
					if (cx->float_stack[cx->float_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_le \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<") ) {
				exp = exp->Cdr();

				if (!((rn=Expressionf(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (float_lt(cx)) {
					if (cx->float_stack[cx->float_stackp-1]) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("float_lt \n");
				}
			} else {
				return 1;
			}
		} else {
			return 0;
		}
	}

	return 1;
}


/* -----------------------------------------------*/

int ComparingC(Context* cx, Node* &exp)
{
//printf("Comparing "); exp->print(); printf("\n");
	int	rn;
	
	if (!((rn=Comp_OrC(cx, exp))>0)) {
		return rn;
	}
	return 1;	
}

int Comp_OrC(Context* cx, Node* &exp)
{
//printf("Comp or "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	rn=Comp_Andf(cx, exp);

	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("or")) {
				exp = exp->Cdr();

				rn=Comp_AndC(cx, exp);
				if (complex_or(cx)) {
					if (cx->complex_stack[
					   cx->complex_stackp-1].real() != 0.0) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_or \n");
				}
			} else {
				return 1;
			}
		} else {
			return 0;
		}
	}

	return 1;
}

int Comp_AndC(Context* cx, Node* &exp)
{
//printf("Comp and "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (!((rn=Comp_NotC(cx, exp))>0)) {
		return rn;
	}

	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("and")) {
				exp = exp->Cdr();

				rn=Comp_NotC(cx, exp);
				if (complex_and(cx)) {
					if (cx->complex_stack[
					  cx->complex_stackp-1].real() != 0.0) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_and \n");
				}
			} else {
				return 1;
			}
		} else {
			return 0;
		}
	}

	return 1;
}

int Comp_NotC(Context* cx, Node* &exp)
{
//printf("Comp not "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("not")) {
				exp = exp->Cdr();

				rn=Comp_GLC(cx, exp);
				exp = exp->Cdr();

				if (complex_not(cx)) {
					if (cx->complex_stack[
					  cx->complex_stackp-1].real() != 0.0) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_not \n");
				}
			} 
		}
	}

	if (!Comp_GLC(cx, exp)) {
		exp = expsave;
		return -1;
	}

	return 1;
}

int Comp_GLC(Context* cx, Node* &exp)
{
//printf("Comp gl "); exp->print(); printf("\n");
	int	rn;
	
	Node* expsave = exp;
	
	if (exp->Car()->kind() == LIST) {
		Node* expbr = exp->Car();
		if ((rn=ComparingC(cx, expbr))>0) {
			exp = exp->Cdr();
			return 1;
		} else {
			exp = expsave;
			return rn;
		}
	}


	if (!((rn=ExpressionC(cx, exp))>0)) {
		return rn;
	}
	if (exp != Nil) {
		if (exp->Car()->kind() == ATOM) {
			if (((Atom*)exp->Car())->EqStr("=") ||
			    ((Atom*)exp->Car())->EqStr("==")) {
				exp = exp->Cdr();

				if (!((rn=ExpressionC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (complex_eq(cx)) {
					if (cx->complex_stack[
					  cx->complex_stackp-1].real()) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_eq \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<>") ||
			           ((Atom*)exp->Car())->EqStr("!=")) {
				exp = exp->Cdr();

				if (!((rn=ExpressionC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (complex_noteq(cx)) {
					if (cx->complex_stack[
					   cx->complex_stackp-1].real()) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_noteq \n");
				}
#if 0
			} else if (((Atom*)exp->Car())->EqStr(">=") ) {
				exp = exp->Cdr();

				if (!((rn=ExpressionC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (complex_ge(cx)) {
					if (cx->complex_stack[
					  cx->complex_stackp-1].real()) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_ge \n");
				}
			} else if (((Atom*)exp->Car())->EqStr(">") ) {
				exp = exp->Cdr();

				if (!((rn=ExpressionC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (complex_gt(cx)) {
					if (cx->complex_stack[
					  cx->complex_stackp-1].real()) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_gt \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<=") ) {
				exp = exp->Cdr();

				if (!((rn=ExpressionC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (complex_le(cx)) {
					if (cx->complex_stack[
					  cx->complex_stackp-1].real()) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_le \n");
				}
			} else if (((Atom*)exp->Car())->EqStr("<") ) {
				exp = exp->Cdr();

				if (!((rn=ExpressionC(cx, exp))>0)) {
					exp = expsave;
					return rn;
				}
				if (complex_lt(cx)) {
					if (cx->complex_stack[
					  cx->complex_stackp-1].real()) {
						return 1;
					} else {
						return -1;
					}
				} else {
					syserr("complex_lt \n");
				}
#endif
			} else {
				return 1;
			}
		} else {
			return 0;
		}
	}

	return 1;
}