static inline Int
a_cmp(Term t1, Term t2)
{
ArithError = FALSE;
if (IsVarTerm(t1)) {
ArithError = TRUE;
Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return FALSE;
}
if (IsVarTerm(t2)) {
ArithError = TRUE;
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return FALSE;
}
if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2));
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
return int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(t2));
}
t1 = Yap_Eval(t1);
if (!t1) {
return FALSE;
}
if (IsIntegerTerm(t1)) {
Int i1 = IntegerOfTerm(t1);
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return int_cmp(i1-i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
Yap_Error_Term = t2;
Yap_ErrorMessage = "trying to evaluate nan";
ArithError = TRUE;
}
#endif
return flt_cmp(i1-f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_int_big(i1,t2);
#endif
} else {
return FALSE;
}
} else if (IsFloatTerm(t1)) {
Float f1 = FloatOfTerm(t1);
#if HAVE_ISNAN
if (isnan(f1)) {
Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
Yap_Error_Term = t1;
Yap_ErrorMessage = "trying to evaluate nan";
ArithError = TRUE;
}
#endif
t2 = Yap_Eval(t2);
#if HAVE_ISNAN
if (isnan(f1))
return -1;
#endif
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return flt_cmp(f1-i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
Yap_Error_Term = t2;
Yap_ErrorMessage = "trying to evaluate nan";
ArithError = TRUE;
}
#endif
return flt_cmp(f1-f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_float_big(f1,t2);
#endif
} else {
return FALSE;
}
#ifdef USE_GMP
} else if (IsBigIntTerm(t1)) {
{
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
return Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
Yap_Error_Term = t2;
Yap_ErrorMessage = "trying to evaluate nan";
ArithError = TRUE;
}
#endif
return Yap_gmp_cmp_big_float(t1, f2);
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_big_big(t1, t2);
} else {
return FALSE;
}
}
#endif
} else {
return FALSE;
}
}
static Int a_cmp(Term t1, Term t2 USES_REGS) {
if (IsVarTerm(t1)) {
Yap_ArithError(INSTANTIATION_ERROR, t1,
"while doing arithmetic comparison");
}
if (IsVarTerm(t2)) {
Yap_ArithError(INSTANTIATION_ERROR, t2,
"while doing arithmetic comparison");
}
if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2));
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
return int_cmp(IntegerOfTerm(t1) - IntegerOfTerm(t2));
}
t1 = Yap_Eval(t1);
if (!t1) {
return FALSE;
}
if (IsIntegerTerm(t1)) {
Int i1 = IntegerOfTerm(t1);
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return int_cmp(i1 - i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return flt_cmp(i1 - f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_int_big(i1, t2);
#endif
} else {
return FALSE;
}
} else if (IsFloatTerm(t1)) {
Float f1 = FloatOfTerm(t1);
#if HAVE_ISNAN
if (isnan(f1)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t1,
"trying to evaluate nan");
}
#endif
t2 = Yap_Eval(t2);
#if HAVE_ISNAN
if (isnan(f1))
return -1;
#endif
if (IsIntegerTerm(t2)) {
Int i2 = IntegerOfTerm(t2);
return flt_cmp(f1 - i2);
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return flt_cmp(f1 - f2);
#ifdef USE_GMP
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_float_big(f1, t2);
#endif
} else {
return FALSE;
}
#ifdef USE_GMP
} else if (IsBigIntTerm(t1)) {
{
t2 = Yap_Eval(t2);
if (IsIntegerTerm(t2)) {
return Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2));
} else if (IsFloatTerm(t2)) {
Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN
if (isnan(f2)) {
Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
}
#endif
return Yap_gmp_cmp_big_float(t1, f2);
} else if (IsBigIntTerm(t2)) {
return Yap_gmp_cmp_big_big(t1, t2);
} else {
return FALSE;
}
}
#endif
} else {
return FALSE;
}
}
/*
* NAME: optimize->binconst()
* DESCRIPTION: optimize a binary operator constant expression
*/
static Uint opt_binconst(node **m)
{
node *n;
xfloat f1, f2;
bool flag;
n = *m;
if (n->l.left->type != n->r.right->type) {
if (n->type == N_EQ) {
node_toint(n, (Int) FALSE);
} else if (n->type == N_NE) {
node_toint(n, (Int) TRUE);
} else {
return 2; /* runtime error expected */
}
return 1;
}
switch (n->l.left->type) {
case N_INT:
switch (n->type) {
case N_ADD_INT:
n->l.left->l.number += n->r.right->l.number;
break;
case N_AND_INT:
n->l.left->l.number &= n->r.right->l.number;
break;
case N_DIV_INT:
if (n->r.right->l.number == 0) {
return 2; /* runtime error: division by 0 */
}
n->l.left->l.number /= n->r.right->l.number;
break;
case N_EQ_INT:
n->l.left->l.number = (n->l.left->l.number == n->r.right->l.number);
break;
case N_GE_INT:
n->l.left->l.number = (n->l.left->l.number >= n->r.right->l.number);
break;
case N_GT_INT:
n->l.left->l.number = (n->l.left->l.number > n->r.right->l.number);
break;
case N_LE_INT:
n->l.left->l.number = (n->l.left->l.number <= n->r.right->l.number);
break;
case N_LSHIFT_INT:
n->l.left->l.number <<= n->r.right->l.number;
break;
case N_LT_INT:
n->l.left->l.number = (n->l.left->l.number < n->r.right->l.number);
break;
case N_MOD_INT:
if (n->r.right->l.number == 0) {
return 2; /* runtime error: % 0 */
}
n->l.left->l.number %= n->r.right->l.number;
break;
case N_MULT_INT:
n->l.left->l.number *= n->r.right->l.number;
break;
case N_NE_INT:
n->l.left->l.number = (n->l.left->l.number != n->r.right->l.number);
break;
case N_OR_INT:
n->l.left->l.number |= n->r.right->l.number;
break;
case N_RSHIFT_INT:
n->l.left->l.number >>= n->r.right->l.number;
break;
case N_SUB_INT:
n->l.left->l.number -= n->r.right->l.number;
break;
case N_XOR_INT:
n->l.left->l.number ^= n->r.right->l.number;
break;
default:
return 2; /* runtime error expected */
}
*m = n->l.left;
(*m)->line = n->line;
return 1;
case N_FLOAT:
NFLT_GET(n->l.left, f1);
NFLT_GET(n->r.right, f2);
switch (n->type) {
case N_ADD:
flt_add(&f1, &f2);
break;
case N_DIV:
if (NFLT_ISZERO(n->r.right)) {
return 2; /* runtime error: division by 0.0 */
}
flt_div(&f1, &f2);
break;
case N_EQ:
node_toint(n->l.left, (Int) (flt_cmp(&f1, &f2) == 0));
break;
case N_GE:
node_toint(n->l.left, (Int) (flt_cmp(&f1, &f2) >= 0));
break;
case N_GT:
node_toint(n->l.left, (Int) (flt_cmp(&f1, &f2) > 0));
break;
case N_LE:
node_toint(n->l.left, (Int) (flt_cmp(&f1, &f2) <= 0));
break;
case N_LT:
node_toint(n->l.left, (Int) (flt_cmp(&f1, &f2) < 0));
break;
case N_MULT:
flt_mult(&f1, &f2);
break;
case N_NE:
node_toint(n->l.left, (Int) (flt_cmp(&f1, &f2) != 0));
break;
case N_SUB:
flt_sub(&f1, &f2);
break;
default:
return 2; /* runtime error expected */
}
NFLT_PUT(n->l.left, f1);
*m = n->l.left;
(*m)->line = n->line;
return 1;
case N_STR:
switch (n->type) {
case N_ADD:
node_tostr(n, str_add(n->l.left->l.string, n->r.right->l.string));
return 1;
case N_EQ:
flag = (str_cmp(n->l.left->l.string, n->r.right->l.string) == 0);
break;
case N_GE:
flag = (str_cmp(n->l.left->l.string, n->r.right->l.string) >= 0);
break;
case N_GT:
flag = (str_cmp(n->l.left->l.string, n->r.right->l.string) > 0);
break;
case N_LE:
flag = (str_cmp(n->l.left->l.string, n->r.right->l.string) <= 0);
break;
case N_LT:
flag = (str_cmp(n->l.left->l.string, n->r.right->l.string) < 0);
break;
case N_NE:
flag = (str_cmp(n->l.left->l.string, n->r.right->l.string) != 0);
break;
default:
return 2; /* runtime error expected */
}
node_toint(n, (Int) flag);
return 1;
case N_NIL:
switch (n->type) {
case N_EQ:
flag = TRUE;
break;
case N_NE:
flag = FALSE;
break;
default:
return 2; /* runtime error expected */
}
node_toint(n, (Int) flag);
return 1;
}
return 2;
}