- simplify error handling in arithmetic and handle infinite terms (#46)
This commit is contained in:
Vitor Santos Costa
parent
e466bf2c5b
commit
9852f7781d
120
C/arith1.c
120
C/arith1.c
|
|
@ -48,7 +48,7 @@ float_to_int(Float v)
|
|||
#define RBIG_FL(v) return(float_to_int(v))
|
||||
|
||||
#if USE_GMP
|
||||
static void
|
||||
static Term
|
||||
process_iso_error(MP_INT *big, Term t, char *operation)
|
||||
{ /* iso */
|
||||
Int sz = 2+mpz_sizeinbase(big,10);
|
||||
|
|
@ -56,12 +56,11 @@ process_iso_error(MP_INT *big, Term t, char *operation)
|
|||
|
||||
if (s != NULL) {
|
||||
mpz_get_str(s, 10, big);
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is %s(%s)", operation, s);
|
||||
Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is %s(%s)", operation, s);
|
||||
Yap_FreeCodeSpace(s);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is %s(t)",operation);
|
||||
P = (yamop *)FAILCODE;
|
||||
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is %s(t)",operation);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
|
@ -145,10 +144,8 @@ msb(Int inp) /* calculate the most significant bit for an integer */
|
|||
int off = sizeof(CELL)*4;
|
||||
|
||||
if (inp < 0) {
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp),
|
||||
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp),
|
||||
"msb/1 received %d", inp);
|
||||
P = (yamop *)FAILCODE;
|
||||
return(0);
|
||||
}
|
||||
|
||||
while (off) {
|
||||
|
|
@ -206,9 +203,7 @@ eval1(Int fi, Term t) {
|
|||
case long_int_e:
|
||||
RINT(~IntegerOfTerm(t));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t, "\\(f)", FloatOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\(f)", FloatOfTerm(t));
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
{
|
||||
|
|
@ -230,9 +225,7 @@ eval1(Int fi, Term t) {
|
|||
if (dbl >= 0) {
|
||||
RFLOAT(log(dbl));
|
||||
} else {
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl);
|
||||
}
|
||||
}
|
||||
case op_log10:
|
||||
|
|
@ -241,9 +234,7 @@ eval1(Int fi, Term t) {
|
|||
if (dbl >= 0) {
|
||||
RFLOAT(log10(dbl));
|
||||
} else {
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl);
|
||||
}
|
||||
}
|
||||
case op_sqrt:
|
||||
|
|
@ -252,9 +243,7 @@ eval1(Int fi, Term t) {
|
|||
out = sqrt(dbl);
|
||||
#if HAVE_ISNAN
|
||||
if (isnan(out)) {
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl);
|
||||
}
|
||||
#endif
|
||||
RFLOAT(out);
|
||||
|
|
@ -303,9 +292,7 @@ eval1(Int fi, Term t) {
|
|||
out = asin(dbl);
|
||||
#if HAVE_ISNAN
|
||||
if (isnan(out)) {
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
}
|
||||
#endif
|
||||
RFLOAT(out);
|
||||
|
|
@ -318,9 +305,7 @@ eval1(Int fi, Term t) {
|
|||
out = acos(dbl);
|
||||
#if HAVE_ISNAN
|
||||
if (isnan(out)) {
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
}
|
||||
#endif
|
||||
RFLOAT(out);
|
||||
|
|
@ -333,9 +318,7 @@ eval1(Int fi, Term t) {
|
|||
out = atan(dbl);
|
||||
#if HAVE_ISNAN
|
||||
if (isnan(out)) {
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
}
|
||||
#endif
|
||||
RFLOAT(out);
|
||||
|
|
@ -348,9 +331,7 @@ eval1(Int fi, Term t) {
|
|||
out = asinh(dbl);
|
||||
#if HAVE_ISNAN
|
||||
if (isnan(out)) {
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
}
|
||||
#endif
|
||||
RFLOAT(out);
|
||||
|
|
@ -363,9 +344,7 @@ eval1(Int fi, Term t) {
|
|||
out = acosh(dbl);
|
||||
#if HAVE_ISNAN
|
||||
if (isnan(out)) {
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
}
|
||||
#endif
|
||||
RFLOAT(out);
|
||||
|
|
@ -378,9 +357,7 @@ eval1(Int fi, Term t) {
|
|||
out = atanh(dbl);
|
||||
#if HAVE_ISNAN
|
||||
if (isnan(out)) {
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl);
|
||||
}
|
||||
#endif
|
||||
RFLOAT(out);
|
||||
|
|
@ -411,9 +388,7 @@ eval1(Int fi, Term t) {
|
|||
switch (ETypeOfTerm(t)) {
|
||||
case long_int_e:
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%f)", IntegerOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(%f)", IntegerOfTerm(t));
|
||||
} else {
|
||||
RFLOAT(IntegerOfTerm(t));
|
||||
}
|
||||
|
|
@ -429,14 +404,11 @@ eval1(Int fi, Term t) {
|
|||
|
||||
if (s != NULL) {
|
||||
mpz_get_str(s, 10, big);
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%s)", s);
|
||||
P = (yamop *)FAILCODE;
|
||||
Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(%s)", s);
|
||||
Yap_FreeCodeSpace(s);
|
||||
RERROR();
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(t)");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(t)");
|
||||
}
|
||||
} else {
|
||||
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
|
||||
|
|
@ -458,9 +430,7 @@ eval1(Int fi, Term t) {
|
|||
switch (ETypeOfTerm(t)) {
|
||||
case long_int_e:
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", IntegerOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", IntegerOfTerm(t));
|
||||
} else {
|
||||
RFLOAT(IntegerOfTerm(t));
|
||||
}
|
||||
|
|
@ -470,8 +440,7 @@ eval1(Int fi, Term t) {
|
|||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
|
||||
process_iso_error(Yap_BigIntOfTerm(t), t, "ceiling");
|
||||
RERROR();
|
||||
return process_iso_error(Yap_BigIntOfTerm(t), t, "ceiling");
|
||||
} else {
|
||||
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
|
||||
}
|
||||
|
|
@ -493,9 +462,7 @@ eval1(Int fi, Term t) {
|
|||
switch (ETypeOfTerm(t)) {
|
||||
case long_int_e:
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%f)", IntegerOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is round(%f)", IntegerOfTerm(t));
|
||||
} else {
|
||||
RFLOAT(IntegerOfTerm(t));
|
||||
}
|
||||
|
|
@ -505,8 +472,7 @@ eval1(Int fi, Term t) {
|
|||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
|
||||
process_iso_error(Yap_BigIntOfTerm(t), t, "round");
|
||||
RERROR();
|
||||
return process_iso_error(Yap_BigIntOfTerm(t), t, "round");
|
||||
} else {
|
||||
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
|
||||
}
|
||||
|
|
@ -553,9 +519,7 @@ eval1(Int fi, Term t) {
|
|||
mpz_init_set_d(&new, dbl);
|
||||
RBIG(&new);
|
||||
#else
|
||||
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer/1");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer/1");
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
|
@ -596,9 +560,7 @@ eval1(Int fi, Term t) {
|
|||
case long_int_e:
|
||||
RINT(msb(IntegerOfTerm(t)));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t));
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
RINT(mpz_sizeinbase(Yap_BigIntOfTerm(t),2));
|
||||
|
|
@ -610,9 +572,7 @@ eval1(Int fi, Term t) {
|
|||
switch (ETypeOfTerm(t)) {
|
||||
case long_int_e:
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t));
|
||||
} else {
|
||||
RFLOAT(0.0);
|
||||
}
|
||||
|
|
@ -626,8 +586,7 @@ eval1(Int fi, Term t) {
|
|||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
|
||||
process_iso_error(Yap_BigIntOfTerm(t), t, "float_fractional_part");
|
||||
RERROR();
|
||||
return process_iso_error(Yap_BigIntOfTerm(t), t, "float_fractional_part");
|
||||
} else {
|
||||
RFLOAT(0.0);
|
||||
}
|
||||
|
|
@ -639,9 +598,7 @@ eval1(Int fi, Term t) {
|
|||
switch (ETypeOfTerm(t)) {
|
||||
case long_int_e:
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
|
||||
Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t));
|
||||
} else {
|
||||
RFLOAT(IntegerOfTerm(t));
|
||||
}
|
||||
|
|
@ -651,8 +608,7 @@ eval1(Int fi, Term t) {
|
|||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
|
||||
process_iso_error(Yap_BigIntOfTerm(t), t, "float_integer_part");
|
||||
RERROR();
|
||||
return process_iso_error(Yap_BigIntOfTerm(t), t, "float_integer_part");
|
||||
} else {
|
||||
RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
|
||||
}
|
||||
|
|
@ -687,14 +643,10 @@ eval1(Int fi, Term t) {
|
|||
case long_int_e:
|
||||
RINT(Yap_random()*IntegerOfTerm(t));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
|
||||
#endif
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
|
|
@ -705,7 +657,7 @@ eval1(Int fi, Term t) {
|
|||
|
||||
Term Yap_eval_unary(Int f, Term t)
|
||||
{
|
||||
return eval1(f,t);
|
||||
return Yap_FoundArithError(eval1(f,t), t);
|
||||
}
|
||||
|
||||
static InitUnEntry InitUnTab[] = {
|
||||
|
|
@ -751,13 +703,13 @@ p_unary_is(void)
|
|||
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, ARG2, "X is Y");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
top = Yap_Eval(Deref(ARG3));
|
||||
if (top == 0L)
|
||||
return FALSE;
|
||||
if (IsIntTerm(t)) {
|
||||
Term tout = eval1(IntegerOfTerm(t), top);
|
||||
Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top), Deref(ARG3));
|
||||
if (!tout)
|
||||
return FALSE;
|
||||
return Yap_unify_constant(ARG1,tout);
|
||||
|
|
@ -777,10 +729,10 @@ p_unary_is(void)
|
|||
Yap_Error(TYPE_ERROR_EVALUABLE, t,
|
||||
"functor %s/%d for arithmetic expression",
|
||||
RepAtom(name)->StrOfAE,1);
|
||||
P = (yamop *)FAILCODE;
|
||||
P = FAILCODE;
|
||||
return(FALSE);
|
||||
}
|
||||
if (!(out=eval1(p->FOfEE, top)))
|
||||
if (!(out=Yap_FoundArithError(eval1(p->FOfEE, top),Deref(ARG3))))
|
||||
return FALSE;
|
||||
return Yap_unify_constant(ARG1,out);
|
||||
}
|
||||
|
|
@ -813,7 +765,7 @@ p_unary_op_as_integer(void)
|
|||
Yap_Error(TYPE_ERROR_EVALUABLE, t,
|
||||
"functor %s/%d for arithmetic expression",
|
||||
RepAtom(name)->StrOfAE,2);
|
||||
P = (yamop *)FAILCODE;
|
||||
P = FAILCODE;
|
||||
return(FALSE);
|
||||
}
|
||||
return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE));
|
||||
|
|
|
|||
112
C/arith2.c
112
C/arith2.c
|
|
@ -78,10 +78,8 @@ p_mod(Term t1, Term t2) {
|
|||
#ifdef USE_GMP
|
||||
return Yap_gmp_add_ints(Int_MAX, 1);
|
||||
#else
|
||||
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, t1,
|
||||
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
|
||||
"// /2 with %d and %d", i1, i2);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
#endif
|
||||
}
|
||||
mod = i1%i2;
|
||||
|
|
@ -90,10 +88,7 @@ p_mod(Term t1, Term t2) {
|
|||
RINT(mod);
|
||||
}
|
||||
case (CELL)double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
#ifdef USE_GMP
|
||||
case (CELL)big_int_e:
|
||||
/* I know the term is much larger, so: */
|
||||
|
|
@ -111,10 +106,7 @@ p_mod(Term t1, Term t2) {
|
|||
break;
|
||||
}
|
||||
case (CELL)double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
case (CELL)big_int_e:
|
||||
#ifdef USE_GMP
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
|
|
@ -142,10 +134,7 @@ p_mod(Term t1, Term t2) {
|
|||
RBIG(&new);
|
||||
}
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
@ -154,10 +143,7 @@ p_mod(Term t1, Term t2) {
|
|||
RERROR();
|
||||
}
|
||||
zero_divisor:
|
||||
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0");
|
||||
}
|
||||
|
||||
static Term
|
||||
|
|
@ -177,20 +163,15 @@ p_rem(Term t1, Term t2) {
|
|||
#ifdef USE_GMP
|
||||
return Yap_gmp_add_ints(Int_MAX, 1);
|
||||
#else
|
||||
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, t1,
|
||||
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
|
||||
"rem/2 with %d and %d", i1, i2);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
#endif
|
||||
}
|
||||
mod = i1%i2;
|
||||
RINT(i1%i2);
|
||||
}
|
||||
case (CELL)double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
#ifdef USE_GMP
|
||||
case (CELL)big_int_e:
|
||||
/* I know the term is much larger, so: */
|
||||
|
|
@ -201,9 +182,7 @@ p_rem(Term t1, Term t2) {
|
|||
}
|
||||
break;
|
||||
case (CELL)double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t1, "mod/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2");
|
||||
#ifdef USE_GMP
|
||||
case (CELL)big_int_e:
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
|
|
@ -231,10 +210,7 @@ p_rem(Term t1, Term t2) {
|
|||
RBIG(&new);
|
||||
}
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
@ -243,10 +219,7 @@ p_rem(Term t1, Term t2) {
|
|||
RERROR();
|
||||
}
|
||||
zero_divisor:
|
||||
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0");
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -370,9 +343,7 @@ p_xor(Term t1, Term t2)
|
|||
/* two integers */
|
||||
RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "#/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
|
||||
#ifdef USE_GMP
|
||||
case big_int_e:
|
||||
{
|
||||
|
|
@ -388,9 +359,7 @@ p_xor(Term t1, Term t2)
|
|||
}
|
||||
break;
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t1, "#/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "#/2");
|
||||
#ifdef USE_GMP
|
||||
case big_int_e:
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
|
|
@ -412,10 +381,7 @@ p_xor(Term t1, Term t2)
|
|||
RBIG(&new);
|
||||
}
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "#/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
@ -634,10 +600,8 @@ p_exp(Term t1, Term t2)
|
|||
Int pow = ipow(i1,i2);
|
||||
|
||||
if (i2 < 0) {
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2,
|
||||
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2,
|
||||
"%d ^ %d", i1, i2);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
}
|
||||
#ifdef USE_GMP
|
||||
/* two integers */
|
||||
|
|
@ -658,9 +622,7 @@ p_exp(Term t1, Term t2)
|
|||
#ifdef USE_GMP
|
||||
case big_int_e:
|
||||
{
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
|
||||
}
|
||||
#endif
|
||||
case db_ref_e:
|
||||
|
|
@ -683,9 +645,7 @@ p_exp(Term t1, Term t2)
|
|||
#ifdef USE_GMP
|
||||
case big_int_e:
|
||||
{
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
|
||||
}
|
||||
#endif
|
||||
case db_ref_e:
|
||||
|
|
@ -703,9 +663,7 @@ p_exp(Term t1, Term t2)
|
|||
case big_int_e:
|
||||
/* two bignums, makes no sense */
|
||||
//
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t1, "^/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t1, "^/2");
|
||||
case double_e:
|
||||
{
|
||||
Float dbl = FloatOfTerm(t2);
|
||||
|
|
@ -735,9 +693,8 @@ gcd(Int m11,Int m21)
|
|||
}
|
||||
if (m11<0 || m21<0) { /* overflow? */
|
||||
/* Oflow = 1; */
|
||||
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
|
||||
Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
|
||||
"gcd/2 with %d and %d", m11, m21);
|
||||
P = (yamop *)FAILCODE;
|
||||
return(1);
|
||||
}
|
||||
if (m11) return(m11);
|
||||
|
|
@ -757,9 +714,8 @@ Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */
|
|||
}
|
||||
if (m11<0 || m21<0) { /* overflow? */
|
||||
/* Oflow = 1; */
|
||||
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
|
||||
Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
|
||||
"gcdmult/2 with %d and %d", m11, m21);
|
||||
P = (yamop *)FAILCODE;
|
||||
return(1);
|
||||
}
|
||||
if (m11) {
|
||||
|
|
@ -789,10 +745,7 @@ p_gcd(Term t1, Term t2)
|
|||
RINT(gcd(i1,i2));
|
||||
}
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "gcd/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
|
||||
#ifdef USE_GMP
|
||||
case big_int_e:
|
||||
/* I know the term is much larger, so: */
|
||||
|
|
@ -813,9 +766,7 @@ p_gcd(Term t1, Term t2)
|
|||
}
|
||||
break;
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t1, "gcd/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "gcd/2");
|
||||
#ifdef USE_GMP
|
||||
case big_int_e:
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
|
|
@ -842,10 +793,7 @@ p_gcd(Term t1, Term t2)
|
|||
RBIG(&new);
|
||||
}
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "gcd/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
@ -1184,7 +1132,7 @@ eval2(Int fi, Term t1, Term t2) {
|
|||
|
||||
Term Yap_eval_binary(Int f, Term t1, Term t2)
|
||||
{
|
||||
return eval2(f,t1,t2);
|
||||
return Yap_FoundArithError(eval2(f,t1,t2), 0L);
|
||||
}
|
||||
|
||||
static InitBinEntry InitBinTab[] = {
|
||||
|
|
@ -1219,7 +1167,7 @@ p_binary_is(void)
|
|||
Term t1, t2;
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t, "X is Y");
|
||||
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
|
||||
return(FALSE);
|
||||
}
|
||||
t1 = Yap_Eval(Deref(ARG3));
|
||||
|
|
@ -1229,7 +1177,7 @@ p_binary_is(void)
|
|||
if (t2 == 0L)
|
||||
return FALSE;
|
||||
if (IsIntTerm(t)) {
|
||||
Term tout = eval2(IntegerOfTerm(t), t1, t2);
|
||||
Term tout = Yap_FoundArithError(eval2(IntegerOfTerm(t), t1, t2), 0L);
|
||||
if (!tout)
|
||||
return FALSE;
|
||||
return Yap_unify_constant(ARG1,tout);
|
||||
|
|
@ -1249,10 +1197,10 @@ p_binary_is(void)
|
|||
Yap_Error(TYPE_ERROR_EVALUABLE, t,
|
||||
"functor %s/%d for arithmetic expression",
|
||||
RepAtom(name)->StrOfAE,2);
|
||||
P = (yamop *)FAILCODE;
|
||||
P = FAILCODE;
|
||||
return(FALSE);
|
||||
}
|
||||
if (!(out=eval2(p->FOfEE, t1, t2)))
|
||||
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L)))
|
||||
return FALSE;
|
||||
return Yap_unify_constant(ARG1,out);
|
||||
}
|
||||
|
|
@ -1285,7 +1233,7 @@ p_binary_op_as_integer(void)
|
|||
Yap_Error(TYPE_ERROR_EVALUABLE, t,
|
||||
"functor %s/%d for arithmetic expression",
|
||||
RepAtom(name)->StrOfAE,2);
|
||||
P = (yamop *)FAILCODE;
|
||||
P = FAILCODE;
|
||||
return(FALSE);
|
||||
}
|
||||
return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE));
|
||||
|
|
@ -1302,6 +1250,10 @@ Yap_InitBinaryExps(void)
|
|||
|
||||
for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) {
|
||||
AtomEntry *ae = RepAtom(Yap_LookupAtom(InitBinTab[i].OpName));
|
||||
if (ae == NULL) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at InitBinaryExps");
|
||||
return;
|
||||
}
|
||||
WRITE_LOCK(ae->ARWLock);
|
||||
if (Yap_GetExpPropHavingLock(ae, 2)) {
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
|
|
|
|||
108
C/eval.c
108
C/eval.c
|
|
@ -33,9 +33,7 @@ static Term
|
|||
Eval(Term t)
|
||||
{
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
|
||||
P = (yamop *)FAILCODE;
|
||||
return 0L;
|
||||
return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic");
|
||||
} else if (IsAtomTerm(t)) {
|
||||
ExpEntry *p;
|
||||
Atom name = AtomOfTerm(t);
|
||||
|
|
@ -48,7 +46,7 @@ Eval(Term t)
|
|||
ti[1] = MkIntegerTerm(0);
|
||||
/* error */
|
||||
terror = Yap_MkApplTerm(FunctorSlash, 2, ti);
|
||||
Yap_Error(TYPE_ERROR_EVALUABLE, terror,
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, terror,
|
||||
"atom %s for arithmetic expression",
|
||||
RepAtom(name)->StrOfAE);
|
||||
P = (yamop *)FAILCODE;
|
||||
|
|
@ -68,40 +66,53 @@ Eval(Term t)
|
|||
return t;
|
||||
default:
|
||||
{
|
||||
Int n = ArityOfFunctor(fun);
|
||||
Atom name = NameOfFunctor(fun);
|
||||
ExpEntry *p;
|
||||
Term t1, t2;
|
||||
|
||||
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
|
||||
Term ti[2];
|
||||
|
||||
/* error */
|
||||
ti[0] = t;
|
||||
ti[1] = MkIntegerTerm(n);
|
||||
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
|
||||
Yap_Error(TYPE_ERROR_EVALUABLE, t,
|
||||
"functor %s/%d for arithmetic expression",
|
||||
RepAtom(name)->StrOfAE,n);
|
||||
if ((Atom)fun == AtomFoundVar) {
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil,
|
||||
"cyclic term in arithmetic expression");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
} else {
|
||||
Int n = ArityOfFunctor(fun);
|
||||
Atom name = NameOfFunctor(fun);
|
||||
ExpEntry *p;
|
||||
Term t1, t2;
|
||||
|
||||
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) {
|
||||
Term ti[2];
|
||||
|
||||
/* error */
|
||||
ti[0] = t;
|
||||
ti[1] = MkIntegerTerm(n);
|
||||
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
|
||||
"functor %s/%d for arithmetic expression",
|
||||
RepAtom(name)->StrOfAE,n);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
}
|
||||
*RepAppl(t) = (CELL)AtomFoundVar;
|
||||
t1 = Eval(ArgOfTerm(1,t));
|
||||
if (t1 == 0L) {
|
||||
*RepAppl(t) = (CELL)fun;
|
||||
return FALSE;
|
||||
}
|
||||
if (n == 1) {
|
||||
*RepAppl(t) = (CELL)fun;
|
||||
return Yap_eval_unary(p->FOfEE, t1);
|
||||
}
|
||||
t2 = Eval(ArgOfTerm(2,t));
|
||||
*RepAppl(t) = (CELL)fun;
|
||||
if (t2 == 0L)
|
||||
return FALSE;
|
||||
return Yap_eval_binary(p->FOfEE,t1,t2);
|
||||
}
|
||||
t1 = Eval(ArgOfTerm(1,t));
|
||||
if (t1 == 0L)
|
||||
return FALSE;
|
||||
if (n == 1)
|
||||
return Yap_eval_unary(p->FOfEE, t1);
|
||||
t2 = Eval(ArgOfTerm(2,t));
|
||||
if (t2 == 0L)
|
||||
return FALSE;
|
||||
return Yap_eval_binary(p->FOfEE,t1,t2);
|
||||
}
|
||||
}
|
||||
} /* else if (IsPairTerm(t)) */ {
|
||||
if (TailOfTerm(t) != TermNil) {
|
||||
Yap_Error(TYPE_ERROR_EVALUABLE, t,
|
||||
Yap_ArithError(TYPE_ERROR_EVALUABLE, t,
|
||||
"string must contain a single character to be evaluated as an arithmetic expression");
|
||||
P = (yamop *)FAILCODE;
|
||||
P = FAILCODE;
|
||||
return 0L;
|
||||
}
|
||||
return Eval(HeadOfTerm(t));
|
||||
|
|
@ -111,7 +122,7 @@ Eval(Term t)
|
|||
Term
|
||||
Yap_Eval(Term t)
|
||||
{
|
||||
return Eval(t);
|
||||
return Yap_FoundArithError(Eval(t), t);
|
||||
}
|
||||
|
||||
#ifdef BEAM
|
||||
|
|
@ -133,16 +144,37 @@ BEAM_is(void)
|
|||
static Int
|
||||
p_is(void)
|
||||
{ /* X is Y */
|
||||
Term out;
|
||||
|
||||
out = Eval(Deref(ARG2));
|
||||
if (out == 0L) {
|
||||
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, ARG2, "is/2");
|
||||
return FALSE;
|
||||
}
|
||||
Term out, t;
|
||||
|
||||
t = Deref(ARG2);
|
||||
out = Yap_FoundArithError(Eval(t), t);
|
||||
if (!out) return FALSE;
|
||||
return Yap_unify_constant(ARG1,out);
|
||||
}
|
||||
|
||||
Int
|
||||
Yap_ArithError(yap_error_number type, Term where, char *format,...)
|
||||
{
|
||||
va_list ap;
|
||||
|
||||
Yap_Error_TYPE = type;
|
||||
Yap_Error_Term = where;
|
||||
if (!Yap_ErrorMessage)
|
||||
Yap_ErrorMessage = Yap_ErrorSay;
|
||||
va_start (ap, format);
|
||||
if (format != NULL) {
|
||||
#if HAVE_VSNPRINTF
|
||||
(void) vsnprintf(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, format, ap);
|
||||
#else
|
||||
(void) vsprintf(Yap_ErrorMessage, format, ap);
|
||||
#endif
|
||||
} else {
|
||||
Yap_ErrorMessage[0] = '\0';
|
||||
}
|
||||
va_end (ap);
|
||||
return 0L;
|
||||
}
|
||||
|
||||
void
|
||||
Yap_InitEval(void)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -28,9 +28,7 @@ MkBigAndClose(MP_INT *new)
|
|||
Term t = Yap_MkBigIntTerm(new);
|
||||
mpz_clear(new);
|
||||
if (t == TermNil) {
|
||||
Yap_Error(RESOURCE_ERROR_STACK, t, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_STACK, t, ">>/2");
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
|
@ -154,8 +152,7 @@ Yap_gmp_div_big_int(MP_INT *b, Int i)
|
|||
if (i > 0) {
|
||||
mpz_tdiv_q_ui(&new, &new, i);
|
||||
} else if (i == 0) {
|
||||
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
|
||||
return 0L;
|
||||
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
|
||||
} else {
|
||||
/* we do not handle MIN_INT */
|
||||
mpz_tdiv_q_ui(&new, &new, -i);
|
||||
|
|
@ -165,8 +162,7 @@ Yap_gmp_div_big_int(MP_INT *b, Int i)
|
|||
if (i > 0) {
|
||||
mpz_fdiv_q_ui(&new, &new, i);
|
||||
} else if (i == 0) {
|
||||
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
|
||||
return 0L;
|
||||
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
|
||||
} else {
|
||||
/* we do not handle MIN_INT */
|
||||
mpz_fdiv_q_ui(&new, &new, -i);
|
||||
|
|
@ -212,7 +208,7 @@ Yap_gmp_sll_big_int(MP_INT *b, Int i)
|
|||
} else {
|
||||
mpz_init_set(&new, b);
|
||||
if (i == Int_MIN) {
|
||||
return 0L;
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, MkIntegerTerm(i), "<</2");
|
||||
}
|
||||
mpz_tdiv_q_2exp(&new, &new, -i);
|
||||
}
|
||||
|
|
|
|||
143
H/arith2.h
143
H/arith2.h
|
|
@ -324,28 +324,20 @@ p_div(Term t1, Term t2) {
|
|||
Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
|
||||
|
||||
if (i2 == 0) {
|
||||
Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
|
||||
} else if (i1 == Int_MIN && i2 == -1) {
|
||||
#ifdef USE_GMP
|
||||
return Yap_gmp_add_ints(Int_MAX, 1);
|
||||
#else
|
||||
Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, t1,
|
||||
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
|
||||
"rem/2 with %d and %d", i1, i2);
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
#endif
|
||||
} else {
|
||||
RINT(IntegerOfTerm(t1) / i2);
|
||||
}
|
||||
}
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "// /2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
/* Cool */
|
||||
|
|
@ -356,41 +348,18 @@ p_div(Term t1, Term t2) {
|
|||
}
|
||||
break;
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t1, "// /2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "// /2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
case long_int_e:
|
||||
/* dividing a bignum by an integer */
|
||||
{
|
||||
Term t= Yap_gmp_div_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2));
|
||||
if (t==0L) {
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
}
|
||||
return(t);
|
||||
}
|
||||
return Yap_gmp_div_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2));
|
||||
case big_int_e:
|
||||
/* two bignums */
|
||||
{
|
||||
Term t;
|
||||
|
||||
t = Yap_gmp_div_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
|
||||
if (t==0L) {
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
}
|
||||
return(t);
|
||||
}
|
||||
return Yap_gmp_div_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "// /2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
@ -410,9 +379,7 @@ p_and(Term t1, Term t2) {
|
|||
/* two integers */
|
||||
RINT(IntegerOfTerm(t1) & IntegerOfTerm(t2));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "/\\ /2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
return(Yap_gmp_and_int_big(IntegerOfTerm(t1),Yap_BigIntOfTerm(t2)));
|
||||
|
|
@ -422,9 +389,7 @@ p_and(Term t1, Term t2) {
|
|||
}
|
||||
break;
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t1, "/\\ /2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "/\\ /2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
|
|
@ -435,10 +400,7 @@ p_and(Term t1, Term t2) {
|
|||
/* two bignums */
|
||||
return(Yap_gmp_and_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1)));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "/\\ /2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
@ -458,9 +420,7 @@ p_or(Term t1, Term t2) {
|
|||
/* two integers */
|
||||
RINT(IntegerOfTerm(t1) | IntegerOfTerm(t2));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "\\/ /2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
return(Yap_gmp_ior_int_big(IntegerOfTerm(t1),Yap_BigIntOfTerm(t2)));
|
||||
|
|
@ -470,9 +430,7 @@ p_or(Term t1, Term t2) {
|
|||
}
|
||||
break;
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t1, "\\/ /2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "\\/ /2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
|
|
@ -483,10 +441,7 @@ p_or(Term t1, Term t2) {
|
|||
/* two bignums */
|
||||
return Yap_gmp_ior_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "\\/ /2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
@ -507,53 +462,32 @@ p_sll(Term t1, Term t2) {
|
|||
if (IntegerOfTerm(t2) < 0) {
|
||||
Int i2 = IntegerOfTerm(t2);
|
||||
if (i2 == Int_MIN) {
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
}
|
||||
RINT(IntegerOfTerm(t1) >> -i2);
|
||||
}
|
||||
return do_sll(IntegerOfTerm(t1),IntegerOfTerm(t2));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "<</2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "<</2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "<</2");
|
||||
#endif
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
break;
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t1, "<< /2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "<< /2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
case long_int_e:
|
||||
{
|
||||
Term t = Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2));
|
||||
if (t == 0L) {
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "<</2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
}
|
||||
return t;
|
||||
}
|
||||
return Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2));
|
||||
case big_int_e:
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, "<</2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
@ -574,55 +508,32 @@ p_slr(Term t1, Term t2) {
|
|||
if (IntegerOfTerm(t2) < 0) {
|
||||
Int i2 = IntegerOfTerm(t2);
|
||||
if (i2 == Int_MIN) {
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
}
|
||||
return do_sll(IntegerOfTerm(t1), -i2);
|
||||
}
|
||||
RINT(IntegerOfTerm(t1) >> IntegerOfTerm(t2));
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
#endif
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
break;
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t1, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, ">>/2");
|
||||
case big_int_e:
|
||||
#ifdef USE_GMP
|
||||
switch (ETypeOfTerm(t2)) {
|
||||
case long_int_e:
|
||||
{
|
||||
Term t;
|
||||
|
||||
t = Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2));
|
||||
if (t == 0L) {
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
}
|
||||
return(t);
|
||||
}
|
||||
return Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2));
|
||||
case big_int_e:
|
||||
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
|
||||
case double_e:
|
||||
Yap_Error(TYPE_ERROR_INTEGER, t2, ">>/2");
|
||||
/* make GCC happy */
|
||||
P = (yamop *)FAILCODE;
|
||||
RERROR();
|
||||
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
|
||||
case db_ref_e:
|
||||
RERROR();
|
||||
}
|
||||
|
|
|
|||
13
H/eval.h
13
H/eval.h
|
|
@ -164,6 +164,19 @@ Term STD_PROTO(Yap_eval_unary,(Int,Term));
|
|||
Term STD_PROTO(Yap_eval_binary,(Int,Term,Term));
|
||||
|
||||
Term STD_PROTO(Yap_Eval,(Term));
|
||||
Int STD_PROTO(Yap_ArithError,(yap_error_number,Term,char *msg, ...));
|
||||
|
||||
inline static Term
|
||||
Yap_FoundArithError(Term t, Term inp)
|
||||
{
|
||||
if (Yap_Error_TYPE) {
|
||||
Yap_Error(Yap_Error_TYPE, (inp ? inp : Yap_Error_Term), Yap_ErrorMessage);
|
||||
P = FAILCODE;
|
||||
return 0L;
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
|
||||
#define RINT(v) return(MkIntegerTerm(v))
|
||||
#define RFLOAT(v) return(MkFloatTerm(v))
|
||||
|
|
|
|||
Reference in New Issue