Rev. | 1514 |
---|---|
Size | 27,143 bytes |
Time | 2012-01-18 23:21:05 |
Author | hniwa |
Log Message | The inheritance relation of the object is improved.
|
/*
* 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;
}