static Int
p_binary_is(void)
{ /* X is Y */
Term t = Deref(ARG2);
Term t1, t2;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE;
}
t2 = Yap_Eval(Deref(ARG4));
if (!Yap_FoundArithError(t2, ARG4)) {
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L);
if (!tout)
return FALSE;
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
Term out;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(1);
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Yap_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,2);
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L)))
return FALSE;
return Yap_unify_constant(ARG1,out);
}
return FALSE;
}
static Int
do_arith23(arith2_op op)
{ /* X is Y */
Term t = Deref(ARG1);
Int out;
Term t1, t2;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(t);
if (t1 == 0L)
return FALSE;
t2 = Yap_Eval(Deref(ARG2));
if (t2 == 0L)
return FALSE;
if (!(out=Yap_FoundArithError(eval2(op, t1, t2), 0L)))
return FALSE;
return Yap_unify_constant(ARG3,out);
}
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;
}
}
static Int
p_setarg( USES_REGS1 )
{
CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
Int i;
if (IsVarTerm(t3) &&
VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) {
/* local variable */
Term tn = MkVarTerm();
Bind_Local(VarOfTerm(t3), tn);
t3 = tn;
}
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
return FALSE;
} else {
if (IsIntTerm(ti))
i = IntOfTerm(ti);
else {
Term te = Yap_Eval(ti);
if (IsIntegerTerm(te)) {
i = IntegerOfTerm(te);
} else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return FALSE;
}
}
}
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
} else if(IsApplTerm(ts)) {
CELL *pt;
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
if (i==0)
Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepAppl(ts)+i;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else if(IsPairTerm(ts)) {
CELL *pt;
if (i < 1 || i > 2) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepPair(ts)+i-1;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
return TRUE;
}
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;
}
}
