diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

support for rational numbers

Browse Source 
make floor and friends return an integer (make it closer to SICStus).
This commit is contained in:
Vítor Santos Costa
2010-05-28 09:53:56 +01:00
parent 09fef1a033
commit 293dadb003
11 changed files with 495 additions and 223 deletions
Download Patch File Download Diff File Expand all files Collapse all files

179
C/arith1.c
View File

@@ -37,9 +37,7 @@ float_to_int(Float v)
if (i-v == 0.0) {
return MkIntegerTerm(i);
} else {
MP_INT o;
mpz_init_set_d(&o, v);
return Yap_MkBigIntTerm(&o);
return Yap_gmp_float_to_big(v);
}
#else
return MkIntegerTerm(v);
@@ -48,24 +46,6 @@ float_to_int(Float v)
#define RBIG_FL(v) return(float_to_int(v))
#if USE_GMP
static Term
process_iso_error(MP_INT *big, Term t, char *operation)
{ /* iso */
Int sz = 2+mpz_sizeinbase(big,10);
char *s = Yap_AllocCodeSpace(sz);
if (s != NULL) {
mpz_get_str(s, 10, big);
Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is %s(%s)", operation, s);
Yap_FreeCodeSpace(s);
RERROR();
} else {
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is %s(t)",operation);
}
}
#endif
typedef struct init_un_eval {
char *OpName;
arith1_op f;
@@ -104,7 +84,7 @@ get_float(Term t) {
}
#ifdef USE_GMP
if (IsBigIntTerm(t)) {
return mpz_get_d(Yap_BigIntOfTerm(t));
return Yap_gmp_to_float(t);
}
#endif
return 0.0;
@@ -434,33 +414,13 @@ eval1(Int fi, Term t) {
switch (ETypeOfTerm(t)) {
case long_int_e:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(%f)", IntegerOfTerm(t));
} else {
RFLOAT(IntegerOfTerm(t));
}
return t;
case double_e:
dbl = FloatOfTerm(t);
break;
case big_int_e:
#ifdef USE_GMP
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
MP_INT *big = Yap_BigIntOfTerm(t);
Int sz = 2+mpz_sizeinbase(big,10);
char *s = Yap_AllocCodeSpace(sz);
if (s != NULL) {
mpz_get_str(s, 10, big);
Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(%s)", s);
Yap_FreeCodeSpace(s);
RERROR();
} else {
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(t)");
}
} else {
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
}
break;
return Yap_gmp_floor(t);
#endif
default:
RERROR();
@@ -483,22 +443,13 @@ eval1(Int fi, Term t) {
Float dbl;
switch (ETypeOfTerm(t)) {
case long_int_e:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", IntegerOfTerm(t));
} else {
RFLOAT(IntegerOfTerm(t));
}
return t;
case double_e:
dbl = FloatOfTerm(t);
break;
case big_int_e:
#ifdef USE_GMP
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return process_iso_error(Yap_BigIntOfTerm(t), t, "ceiling");
} else {
dbl = mpz_get_d(Yap_BigIntOfTerm(t));
}
break;
return Yap_gmp_ceiling(t);
#endif
default:
RERROR();
@@ -522,21 +473,13 @@ eval1(Int fi, Term t) {
switch (ETypeOfTerm(t)) {
case long_int_e:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is round(%ld)", IntegerOfTerm(t));
} else {
return t;
}
return t;
case double_e:
dbl = FloatOfTerm(t);
break;
case big_int_e:
#ifdef USE_GMP
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
return process_iso_error(Yap_BigIntOfTerm(t), t, "round");
}
return t;
break;
return Yap_gmp_round(t);
#endif
default:
RERROR();
@@ -560,19 +503,13 @@ eval1(Int fi, Term t) {
Float dbl;
switch (ETypeOfTerm(t)) {
case long_int_e:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is round(%ld)", IntegerOfTerm(t));
}
return t;
case double_e:
dbl = FloatOfTerm(t);
break;
case big_int_e:
#ifdef USE_GMP
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is round(BIGNUM)");
}
return t;
return Yap_gmp_trunc(t);
#endif
default:
RERROR();
@@ -588,18 +525,10 @@ eval1(Int fi, Term t) {
(%f)",dbl);
}
#endif
if (dbl <= (Float)Int_MAX && dbl >= (Float)Int_MIN) {
RINT((Int) dbl);
} else {
#ifdef USE_GMP
MP_INT new;
mpz_init_set_d(&new, dbl);
RBIG(&new);
#else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer/1");
#endif
}
if (dbl < 0.0)
RBIG_FL(ceil(dbl));
else
RBIG_FL(floor(dbl));
}
case op_float:
switch (ETypeOfTerm(t)) {
@@ -609,11 +538,37 @@ eval1(Int fi, Term t) {
return t;
case big_int_e:
#ifdef USE_GMP
RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
RFLOAT(Yap_gmp_to_float(t));
#endif
default:
RERROR();
}
case op_rational:
switch (ETypeOfTerm(t)) {
case long_int_e:
return t;
#ifdef USE_GMP
case double_e:
return Yap_gmp_float_to_rational(FloatOfTerm(t));
#endif
case big_int_e:
return t;
default:
RERROR();
}
case op_rationalize:
switch (ETypeOfTerm(t)) {
case long_int_e:
return t;
#ifdef USE_GMP
case double_e:
return Yap_gmp_float_rationalize(FloatOfTerm(t));
#endif
case big_int_e:
return t;
default:
RERROR();
}
case op_abs:
switch (ETypeOfTerm(t)) {
case long_int_e:
@@ -622,13 +577,7 @@ eval1(Int fi, Term t) {
RFLOAT(fabs(FloatOfTerm(t)));
case big_int_e:
#ifdef USE_GMP
{
MP_INT new;
mpz_init_set(&new, Yap_BigIntOfTerm(t));
mpz_abs(&new, &new);
RBIG(&new);
}
return Yap_gmp_abs_big(t);
#endif
default:
RERROR();
@@ -641,13 +590,7 @@ eval1(Int fi, Term t) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t));
case big_int_e:
#ifdef USE_GMP
{ MP_INT *big = Yap_BigIntOfTerm(t);
if ( mpz_sgn(big) <= 0 ) {
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t,
"msb/1 received bignum");
}
RINT(mpz_sizeinbase(big,2));
}
return Yap_gmp_msb(t);
#endif
default:
RERROR();
@@ -660,13 +603,7 @@ eval1(Int fi, Term t) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "lsb(%f)", FloatOfTerm(t));
case big_int_e:
#ifdef USE_GMP
{ MP_INT *big = Yap_BigIntOfTerm(t);
if ( mpz_sgn(big) <= 0 ) {
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t,
"lsb/1 received bignum");
}
RINT(mpz_scan1(big,0));
}
return Yap_gmp_lsb(t);
#endif
default:
RERROR();
@@ -679,13 +616,7 @@ eval1(Int fi, Term t) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount(%f)", FloatOfTerm(t));
case big_int_e:
#ifdef USE_GMP
{ MP_INT *big = Yap_BigIntOfTerm(t);
if ( mpz_sgn(big) <= 0 ) {
return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t,
"popcount/1 received negative bignum");
}
RINT(mpz_popcount(big));
}
return Yap_gmp_popcount(t);
#endif
default:
RERROR();
@@ -707,11 +638,7 @@ eval1(Int fi, Term t) {
break;
case big_int_e:
#ifdef USE_GMP
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return process_iso_error(Yap_BigIntOfTerm(t), t, "float_fractional_part");
} else {
RFLOAT(0.0);
}
return Yap_gmp_float_fractional_part(t);
#endif
default:
RERROR();
@@ -719,21 +646,13 @@ eval1(Int fi, Term t) {
case op_fintp:
switch (ETypeOfTerm(t)) {
case long_int_e:
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t));
} else {
RFLOAT(IntegerOfTerm(t));
}
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t));
case double_e:
RFLOAT(rint(FloatOfTerm(t)));
break;
case big_int_e:
#ifdef USE_GMP
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
return process_iso_error(Yap_BigIntOfTerm(t), t, "float_integer_part");
} else {
RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
}
return Yap_gmp_float_integer_part(t);
#endif
default:
RERROR();
@@ -755,7 +674,7 @@ eval1(Int fi, Term t) {
}
case big_int_e:
#ifdef USE_GMP
RINT(mpz_sgn(Yap_BigIntOfTerm(t)));
return Yap_gmp_sign(t);
#endif
default:
RERROR();
@@ -818,6 +737,8 @@ static InitUnEntry InitUnTab[] = {
{"lgamma", op_lgamma},
{"erf",op_erf},
{"erfc",op_erfc},
{"rational",op_rational},
{"rationalize",op_rationalize},
{"random", op_random1}
};