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

rational number support. First pass.

Browse Source
This commit is contained in:
Vítor Santos Costa 2010-05-27 12:24:15 +01:00
parent 215581ffc8
commit 09fef1a033
8 changed files with 1313 additions and 455 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
C/arith1.c
View File

@ -218,11 +218,7 @@ eval1(Int fi, Term t) {
Int i = IntegerOfTerm(t);
if (i == Int_MIN) {
MP_INT new;
mpz_init_set_si(&new, i);
mpz_neg(&new, &new);
RBIG(&new);
return Yap_gmp_neg_int(i);
}
else
#endif
@ -231,15 +227,7 @@ eval1(Int fi, Term t) {
case double_e:
RFLOAT(-FloatOfTerm(t));
case big_int_e:
#ifdef USE_GMP
{
MP_INT new;
mpz_init_set(&new, Yap_BigIntOfTerm(t));
mpz_neg(&new, &new);
RBIG(&new);
}
#endif
return Yap_gmp_neg_big(t);
default:
RERROR();
}
@ -248,16 +236,10 @@ eval1(Int fi, Term t) {
case long_int_e:
RINT(~IntegerOfTerm(t));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\(f)", FloatOfTerm(t));
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\(%f)", FloatOfTerm(t));
case big_int_e:
#ifdef USE_GMP
{
MP_INT new;
mpz_init_set(&new, Yap_BigIntOfTerm(t));
mpz_com(&new, &new);
RBIG(&new);
}
return Yap_gmp_unot_big(t);
#endif
default:
RERROR();

375
C/arith2.c
View File

@ -36,31 +36,6 @@ typedef struct init_un_eval {
} InitBinEntry;
#ifdef USE_GMP
static Float
fdiv_bigint(MP_INT *b1,MP_INT *b2)
{
Float f1 = mpz_get_d(b1);
Float f2 = mpz_get_d(b2);
if (1) {
mpf_t f1,f2;
Float res;
mpf_init(f1);
mpf_init(f2);
mpf_set_z(f1, b1);
mpf_set_z(f2, b2);
mpf_div(f1, f1, f2);
res = mpf_get_d(f1);
mpf_clear(f1);
mpf_clear(f2);
return(res);
} else {
return(f1/f2);
}
}
#endif
static Term
p_mod(Term t1, Term t2) {
switch (ETypeOfTerm(t1)) {
@ -91,7 +66,7 @@ p_mod(Term t1, Term t2) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
return Yap_gmp_mod_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2));
return Yap_gmp_mod_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -108,11 +83,11 @@ p_mod(Term t1, Term t2) {
Int i2 = IntegerOfTerm(t2);
if (i2 == 0) goto zero_divisor;
return Yap_gmp_mod_big_int(Yap_BigIntOfTerm(t1), i2);
return Yap_gmp_mod_big_int(t1, i2);
}
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_mod_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
return Yap_gmp_mod_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
@ -154,8 +129,7 @@ p_rem(Term t1, Term t2) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case (CELL)big_int_e:
#ifdef USE_GMP
/* I know the term is much larger, so: */
RINT(IntegerOfTerm(t1));
return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -167,28 +141,57 @@ p_rem(Term t1, Term t2) {
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* modulo between bignum and integer */
return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2));
case (CELL)big_int_e:
/* two bignums */
return Yap_gmp_rem_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
RERROR();
}
#endif
default:
RERROR();
}
zero_divisor:
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0");
}
static Term
p_rdiv(Term t1, Term t2) {
switch (ETypeOfTerm(t1)) {
case (CELL)double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2");
#ifdef USE_GMP
case (CELL)long_int_e:
switch (ETypeOfTerm(t2)) {
case (CELL)long_int_e:
/* two integers */
{
mpz_t tmp;
MP_INT new;
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
if (i2 == 0) goto zero_divisor;
mpz_init(&new);
mpz_init_set_si(tmp, i2);
mpz_tdiv_r(&new, Yap_BigIntOfTerm(t1), tmp);
mpz_clear(tmp);
RBIG(&new);
return Yap_gmq_rdiv_int_int(i1, i2);
}
case (CELL)big_int_e:
/* two bignums */
{
MP_INT new;
mpz_init(&new);
mpz_tdiv_r(&new, Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
RBIG(&new);
}
/* I know the term is much larger, so: */
return Yap_gmq_rdiv_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
}
break;
#ifdef USE_GMP
case (CELL)big_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* I know the term is much larger, so: */
return Yap_gmq_rdiv_big_int(t1, IntegerOfTerm(t2));
case (CELL)big_int_e:
return Yap_gmq_rdiv_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
default:
@ -228,11 +231,7 @@ p_fdiv(Term t1, Term t2)
}
case (CELL)big_int_e:
#ifdef USE_GMP
{
Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(Yap_BigIntOfTerm(t2));
RFLOAT(((Float)i1/f2));
}
return Yap_gmp_fdiv_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -253,9 +252,7 @@ p_fdiv(Term t1, Term t2)
}
case big_int_e:
#ifdef USE_GMP
{
RFLOAT(FloatOfTerm(t1)/mpz_get_d(Yap_BigIntOfTerm(t2)));
}
return Yap_gmp_fdiv_float_big(FloatOfTerm(t1), t2);
#endif
default:
RERROR();
@ -265,19 +262,12 @@ p_fdiv(Term t1, Term t2)
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))/(Float)i);
}
return Yap_gmp_fdiv_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
/* two bignums*/
RFLOAT(fdiv_bigint(Yap_BigIntOfTerm(t1),Yap_BigIntOfTerm(t2)));
// RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))/mpz_get_d(Yap_BigIntOfTerm(t2)));
return Yap_gmp_fdiv_big_big(t1, t2);
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))/dbl);
}
return Yap_gmp_fdiv_big_float(t1, FloatOfTerm(t2));
default:
RERROR();
}
@ -288,27 +278,6 @@ p_fdiv(Term t1, Term t2)
RERROR();
}
#if USE_GMP
#if !defined(HAVE_MPZ_XOR)
static void
mpz_xor(MP_INT *new, MP_INT *r1, MP_INT *r2)
{
MP_INT *n2, *n3;
mpz_new(n2);
mpz_new(n3);
mpz_ior(new, r1, r2);
mpz_com(n2, r1);
mpz_and(n2, n2, new);
mpz_com(n3, r2);
mpz_and(n3, n3, new);
mpz_ior(new, n2, n3);
mpz_clear(n2);
mpz_clear(n3);
}
#endif
#endif
/*
xor #
*/
@ -326,13 +295,7 @@ p_xor(Term t1, Term t2)
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
case big_int_e:
#ifdef USE_GMP
{
MP_INT new;
mpz_init_set_si(&new,IntegerOfTerm(t1));
mpz_xor(&new, &new, Yap_BigIntOfTerm(t2));
RBIG(&new);
}
return Yap_gmp_xor_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -344,22 +307,9 @@ p_xor(Term t1, Term t2)
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
MP_INT new;
mpz_init_set_si(&new,IntegerOfTerm(t2));
mpz_xor(&new, Yap_BigIntOfTerm(t1), &new);
RBIG(&new);
}
return Yap_gmp_xor_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
{
MP_INT new;
mpz_init_set(&new, Yap_BigIntOfTerm(t1));
mpz_xor(&new, &new, Yap_BigIntOfTerm(t2));
RBIG(&new);
}
return Yap_gmp_xor_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
default:
@ -390,7 +340,7 @@ p_atan2(Term t1, Term t2)
#ifdef USE_GMP
{
Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(Yap_BigIntOfTerm(t2));
Float f2 = Yap_gmp_to_float(t2);
RFLOAT(atan2(i1,f2));
}
#endif
@ -414,7 +364,7 @@ p_atan2(Term t1, Term t2)
case big_int_e:
#ifdef USE_GMP
{
RFLOAT(atan2(FloatOfTerm(t1),mpz_get_d(Yap_BigIntOfTerm(t2))));
RFLOAT(atan2(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
}
#endif
default:
@ -423,22 +373,25 @@ p_atan2(Term t1, Term t2)
break;
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
RFLOAT(atan2(mpz_get_d(Yap_BigIntOfTerm(t1)),i));
{
Float dbl1 = Yap_gmp_to_float(t1);
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
RFLOAT(atan2(dbl1,i));
}
case big_int_e:
/* two bignums */
RFLOAT(atan2(dbl1,Yap_gmp_to_float(t2)));
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(atan2(dbl1,dbl));
}
default:
RERROR();
}
case big_int_e:
/* two bignums */
RFLOAT(atan2(mpz_get_d(Yap_BigIntOfTerm(t1)),mpz_get_d(Yap_BigIntOfTerm(t2))));
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(atan2(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl));
}
default:
RERROR();
}
#endif
default:
@ -475,7 +428,7 @@ p_power(Term t1, Term t2)
#ifdef USE_GMP
{
Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(Yap_BigIntOfTerm(t2));
Float f2 = Yap_gmp_to_float(t2);
RFLOAT(pow(i1,f2));
}
#endif
@ -499,7 +452,7 @@ p_power(Term t1, Term t2)
case big_int_e:
#ifdef USE_GMP
{
RFLOAT(pow(FloatOfTerm(t1),mpz_get_d(Yap_BigIntOfTerm(t2))));
RFLOAT(pow(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
}
#endif
default:
@ -512,15 +465,15 @@ p_power(Term t1, Term t2)
case long_int_e:
{
Int i = IntegerOfTerm(t2);
RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),i));
RFLOAT(pow(Yap_gmp_to_float(t1),i));
}
case big_int_e:
/* two bignums */
RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),mpz_get_d(Yap_BigIntOfTerm(t2))));
RFLOAT(pow(Yap_gmp_to_float(t1),Yap_gmp_to_float(t2)));
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl));
RFLOAT(pow(Yap_gmp_to_float(t1),dbl));
}
default:
RERROR();
@ -587,7 +540,7 @@ p_exp(Term t1, Term t2)
/* two integers */
if ((i1 && !pow)) {
/* overflow */
return Yap_gmp_exp_ints(i1, i2);
return Yap_gmp_exp_int_int(i1, i2);
}
#endif
RINT(pow);
@ -602,7 +555,8 @@ p_exp(Term t1, Term t2)
case big_int_e:
#ifdef USE_GMP
{
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
Int i = IntegerOfTerm(t1);
return Yap_gmp_exp_int_big(i,t2);
}
#endif
default:
@ -625,7 +579,7 @@ p_exp(Term t1, Term t2)
case big_int_e:
#ifdef USE_GMP
{
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
RFLOAT(pow(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
}
#endif
default:
@ -638,16 +592,15 @@ p_exp(Term t1, Term t2)
case long_int_e:
{
Int i = IntegerOfTerm(t2);
return Yap_gmp_exp_big_int(Yap_BigIntOfTerm(t1),i);
return Yap_gmp_exp_big_int(t1,i);
}
case big_int_e:
/* two bignums, makes no sense */
//
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t1, "^/2");
return Yap_gmp_exp_big_big(t1,t2);
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl));
RFLOAT(pow(Yap_gmp_to_float(t1),dbl));
}
default:
RERROR();
@ -728,18 +681,7 @@ p_gcd(Term t1, Term t2)
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
case big_int_e:
#ifdef USE_GMP
/* I know the term is much larger, so: */
{
Int i = IntegerOfTerm(t1);
if (i > 0) {
RINT(mpz_gcd_ui(NULL,Yap_BigIntOfTerm(t2),i));
} else if (i == 0) {
RINT(0);
} else {
RINT(mpz_gcd_ui(NULL,Yap_BigIntOfTerm(t2),-i));
}
}
return Yap_gmp_gcd_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -751,27 +693,9 @@ p_gcd(Term t1, Term t2)
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* modulo between bignum and integer */
{
Int i = IntegerOfTerm(t2);
if (i > 0) {
RINT(mpz_gcd_ui(NULL,Yap_BigIntOfTerm(t1),i));
} else if (i == 0) {
RINT(0);
} else {
RINT(mpz_gcd_ui(NULL,Yap_BigIntOfTerm(t1),-i));
}
}
return Yap_gmp_gcd_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
{
MP_INT new;
mpz_init_set(&new, Yap_BigIntOfTerm(t1));
mpz_gcd(&new, &new, Yap_BigIntOfTerm(t2));
RBIG(&new);
}
return Yap_gmp_gcd_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
default:
@ -811,15 +735,10 @@ p_min(Term t1, Term t2)
}
case big_int_e:
#ifdef USE_GMP
{
Int i = IntegerOfTerm(t1);
MP_INT *b = Yap_BigIntOfTerm(t2);
if (mpz_cmp_si(b,i) < 0) {
return t2;
}
if (Yap_gmp_cmp_int_big(IntegerOfTerm(t1), t2) < 0) {
return t1;
}
return t2;
#endif
default:
RERROR();
@ -848,15 +767,10 @@ p_min(Term t1, Term t2)
}
case big_int_e:
#ifdef USE_GMP
{
Float fl1 = FloatOfTerm(t1);
Float fl2 = mpz_get_d(Yap_BigIntOfTerm(t2));
if (fl1 <= fl2) {
return t1;
} else {
return t2;
}
if (Yap_gmp_cmp_float_big(FloatOfTerm(t1), t2) < 0) {
return t1;
}
return t2;
#endif
default:
RERROR();
@ -866,37 +780,20 @@ p_min(Term t1, Term t2)
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
MP_INT *b = Yap_BigIntOfTerm(t1);
if (mpz_cmp_si(b,i) < 0) {
return t1;
}
return t2;
if (Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)) < 0) {
return t1;
}
return t2;
case big_int_e:
/* two bignums */
{
MP_INT *b1 = Yap_BigIntOfTerm(t1);
MP_INT *b2 = Yap_BigIntOfTerm(t2);
if (mpz_cmp(b1,b2) < 0) {
return t1;
} else {
return t2;
}
if (Yap_gmp_cmp_big_big(t1, t2) < 0) {
return t1;
}
return t2;
case double_e:
{
Float fl1 = FloatOfTerm(t2);
Float fl2 = mpz_get_d(Yap_BigIntOfTerm(t1));
if (fl1 <= fl2) {
return t2;
} else {
return t1;
}
if (Yap_gmp_cmp_big_float(t1, FloatOfTerm(t2)) < 0) {
return t1;
}
return t2;
default:
RERROR();
}
@ -934,15 +831,10 @@ p_max(Term t1, Term t2)
}
case big_int_e:
#ifdef USE_GMP
{
Int i = IntegerOfTerm(t1);
MP_INT *b = Yap_BigIntOfTerm(t2);
if (mpz_cmp_si(b,i) > 0) {
return t2;
}
if (Yap_gmp_cmp_int_big(IntegerOfTerm(t1), t2) > 0) {
return t1;
}
return t2;
#endif
default:
RERROR();
@ -971,15 +863,10 @@ p_max(Term t1, Term t2)
}
case big_int_e:
#ifdef USE_GMP
{
Float fl1 = FloatOfTerm(t1);
Float fl2 = mpz_get_d(Yap_BigIntOfTerm(t2));
if (fl1 >= fl2) {
return t1;
} else {
return t2;
}
if (Yap_gmp_cmp_float_big(FloatOfTerm(t1), t2) > 0) {
return t1;
}
return t2;
#endif
default:
RERROR();
@ -989,37 +876,20 @@ p_max(Term t1, Term t2)
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
MP_INT *b = Yap_BigIntOfTerm(t1);
if (mpz_cmp_si(b,i) > 0) {
return t1;
}
return t2;
if (Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)) > 0) {
return t1;
}
return t2;
case big_int_e:
/* two bignums */
{
MP_INT *b1 = Yap_BigIntOfTerm(t1);
MP_INT *b2 = Yap_BigIntOfTerm(t2);
if (mpz_cmp(b1,b2) > 0) {
return t1;
} else {
return t2;
}
if (Yap_gmp_cmp_big_big(t1, t2) > 0) {
return t1;
}
return t2;
case double_e:
{
Float fl1 = FloatOfTerm(t2);
Float fl2 = mpz_get_d(Yap_BigIntOfTerm(t1));
if (fl1 >= fl2) {
return t2;
} else {
return t1;
}
if (Yap_gmp_cmp_big_float(t1, FloatOfTerm(t2)) > 0) {
return t1;
}
return t2;
default:
RERROR();
}
@ -1070,6 +940,8 @@ eval2(Int fi, Term t1, Term t2) {
return p_min(t1, t2);
case op_max:
return p_max(t1, t2);
case op_rdiv:
return p_rdiv(t1, t2);
}
RERROR();
}
@ -1103,7 +975,8 @@ static InitBinEntry InitBinTab[] = {
{"exp", op_power2},
{"gcd", op_gcd},
{"min", op_min},
{"max", op_max}
{"max", op_max},
{"rdiv", op_rdiv}
};
static Int

48
C/bignum.c
View File

@ -66,6 +66,54 @@ Yap_BigIntOfTerm(Term t)
return(new);
}
Term
Yap_MkBigRatTerm(MP_RAT *big)
{
Int nlimbs;
MP_INT *dst = (MP_INT *)(H+2);
MP_INT *num = mpq_numref(big);
MP_INT *den = mpq_denref(big);
MP_RAT *rat;
CELL *ret = H;
if (mpz_cmp_si(den, 1) == 0)
return Yap_MkBigIntTerm(num);
if ((num->_mp_alloc+den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize) > (ASP-ret)-1024) {
return TermNil;
}
H[0] = (CELL)FunctorBigInt;
H[1] = BIG_RATIONAL;
dst->_mp_alloc = 0;
rat = (MP_RAT *)(dst+1);
rat->_mp_num._mp_size = num->_mp_size;
rat->_mp_num._mp_alloc = num->_mp_alloc;
nlimbs = (num->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
memmove((void *)(rat+1), (const void *)(num->_mp_d), nlimbs*CellSize);
rat->_mp_den._mp_size = den->_mp_size;
rat->_mp_den._mp_alloc = den->_mp_alloc;
H = (CELL *)(rat+1)+nlimbs;
nlimbs = (den->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
memmove((void *)(H), (const void *)(den->_mp_d), nlimbs*CellSize);
H += nlimbs;
dst->_mp_size = (H-(CELL *)rat);
H[0] = EndSpecials;
H++;
return AbsAppl(ret);
}
MP_RAT *
Yap_BigRatOfTerm(Term t)
{
MP_RAT *new = (MP_RAT *)(RepAppl(t)+2+sizeof(MP_INT)/sizeof(CELL));
mp_limb_t *nt;
nt = new->_mp_num._mp_d = (mp_limb_t *)(new+1);
nt += new->_mp_num._mp_alloc;
new->_mp_den._mp_d = nt;
return new;
}
#endif
Term

1060
C/gmp_support.c
View File

File diff suppressed because it is too large Load Diff

112
C/write.c
View File

@ -123,6 +123,116 @@ wrputws(wchar_t *s, wrf writewch) /* writes a string */
wrputc(*s++, writewch);
}
#ifdef USE_GMP
static char *
ensure_space(size_t sz) {
char *s;
s = (char *) Yap_PreAllocCodeSpace();
while (s+sz >= (char *)AuxSp) {
#if USE_SYSTEM_MALLOC
/* may require stack expansion */
if (!Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE)) {
s = NULL;
break;
}
s = (char *) Yap_PreAllocCodeSpace();
#else
s = NULL;
#endif
}
if (!s) {
s = (char *)TR;
while (s+sz >= Yap_TrailTop) {
if (!Yap_growtrail(sz/sizeof(CELL), FALSE)) {
s = NULL;
break;
}
s = (char *)TR;
}
}
if (!s) {
s = (char *)H;
if (s+sz >= (char *)ASP) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"not enough space to write bignum: it requires %d bytes", sz);
s = NULL;
}
}
return s;
}
static void
write_mpint(MP_INT *big, wrf writewch) {
char *s;
s = ensure_space(3+mpz_sizeinbase(big, 10));
if (mpz_sgn(big) < 0) {
if (lastw == symbol)
wrputc(' ', writewch);
} else {
if (lastw == alphanum)
wrputc(' ', writewch);
}
if (!s) {
s = mpz_get_str(NULL, 10, big);
if (!s)
return;
wrputs(s,writewch);
free(s);
} else {
mpz_get_str(s, 10, big);
wrputs(s,writewch);
}
}
static void
write_mpq(MP_RAT *q, wrf writewch) {
char *s;
size_t sz;
fprintf(stderr,"%ld %ld\n",mpz_sizeinbase (mpq_numref(q), 10),mpz_sizeinbase (mpq_denref(q), 10));
sz = ((size_t)3) +mpz_sizeinbase(mpq_numref(q), 10)+ mpz_sizeinbase (mpq_denref(q), 10);
s = ensure_space(sz);
if (mpq_sgn(q) < 0) {
if (lastw == symbol)
wrputc(' ', writewch);
} else {
if (lastw == alphanum)
wrputc(' ', writewch);
}
if (!s) {
s = mpq_get_str(NULL, 10, q);
if (!s)
return;
wrputs(s,writewch);
free(s);
} else {
mpq_get_str(s, 10, q);
wrputs(s,writewch);
}
}
#endif
static void
writebig(Term t, wrf writewch) /* writes an integer */
{
#ifdef USE_GMP
CELL *pt = RepAppl(t)+1;
if (pt[0] == BIG_INT)
{
MP_INT *big = Yap_BigIntOfTerm(t);
write_mpint(big, writewch);
return;
} else if (pt[0] == BIG_RATIONAL) {
MP_RAT *q = Yap_BigRatOfTerm(t);
write_mpq(q, writewch);
return;
}
#endif
wrputs("0",writewch);
}
static void
wrputf(Float f, wrf writewch) /* writes a float */
@ -630,6 +740,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputn(LongIntOfTerm(t),wglb->writewch);
return;
case (CELL)FunctorBigInt:
writebig(t,wglb->writewch);
return;
#ifdef USE_GMP
{
MP_INT *big = Yap_BigIntOfTerm(t);

8
H/TermExt.h
View File

@ -311,6 +311,11 @@ typedef struct {
mp_limb_t *_mp_d;
} MP_INT;
typedef struct {
MP_INT _mp_num;
MP_INT _mp_den;
} MP_RAT;
#endif
inline EXTERN int IsBigIntTerm (Term);
@ -326,6 +331,9 @@ IsBigIntTerm (Term t)
Term STD_PROTO (Yap_MkBigIntTerm, (MP_INT *));
MP_INT *STD_PROTO (Yap_BigIntOfTerm, (Term));
Term STD_PROTO (Yap_MkBigRatTerm, (MP_RAT *));
MP_RAT *STD_PROTO (Yap_BigRatOfTerm, (Term));
inline EXTERN void MPZ_SET (mpz_t, MP_INT *);
inline EXTERN void

54
H/arith2.h
View File

@ -156,7 +156,7 @@ p_plus(Term t1, Term t2) {
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
#endif
default:
RERROR();
@ -170,7 +170,7 @@ p_plus(Term t1, Term t2) {
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_add_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
return Yap_gmp_add_float_big(FloatOfTerm(t1),t2);
#endif
default:
RERROR();
@ -179,12 +179,12 @@ p_plus(Term t1, Term t2) {
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return(Yap_gmp_add_int_big(IntegerOfTerm(t2), Yap_BigIntOfTerm(t1)));
return Yap_gmp_add_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
return(Yap_gmp_add_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
return Yap_gmp_add_big_big(t1, t2);
case double_e:
return(Yap_gmp_add_float_big(FloatOfTerm(t2),Yap_BigIntOfTerm(t1)));
return Yap_gmp_add_float_big(FloatOfTerm(t2),t1);
default:
RERROR();
}
@ -212,7 +212,7 @@ p_minus(Term t1, Term t2) {
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_sub_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
return Yap_gmp_sub_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -229,7 +229,7 @@ p_minus(Term t1, Term t2) {
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_sub_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
return Yap_gmp_sub_float_big(FloatOfTerm(t1),t2);
#endif
default:
RERROR();
@ -239,11 +239,11 @@ p_minus(Term t1, Term t2) {
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return(Yap_gmp_sub_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2)));
return Yap_gmp_sub_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
return(Yap_gmp_sub_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
return Yap_gmp_sub_big_big(t1, t2);
case double_e:
return(Yap_gmp_sub_big_float(Yap_BigIntOfTerm(t1),FloatOfTerm(t2)));
return Yap_gmp_sub_big_float(t1,FloatOfTerm(t2));
default:
RERROR();
}
@ -272,7 +272,7 @@ p_times(Term t1, Term t2) {
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_mul_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
return(Yap_gmp_mul_int_big(IntegerOfTerm(t1), t2));
#endif
default:
RERROR();
@ -287,7 +287,7 @@ p_times(Term t1, Term t2) {
RFLOAT(FloatOfTerm(t1)*FloatOfTerm(t2));
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_mul_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
return Yap_gmp_mul_float_big(FloatOfTerm(t1),t2);
#endif
default:
RERROR();
@ -297,12 +297,12 @@ p_times(Term t1, Term t2) {
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return(Yap_gmp_mul_int_big(IntegerOfTerm(t2), Yap_BigIntOfTerm(t1)));
return Yap_gmp_mul_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
return(Yap_gmp_mul_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
return Yap_gmp_mul_big_big(t1, t2);
case double_e:
return(Yap_gmp_mul_float_big(FloatOfTerm(t2),Yap_BigIntOfTerm(t1)));
return Yap_gmp_mul_float_big(FloatOfTerm(t2),t1);
default:
RERROR();
}
@ -340,8 +340,8 @@ p_div(Term t1, Term t2) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
case big_int_e:
#ifdef USE_GMP
/* Cool */
RINT(0);
/* dividing a bignum by an integer */
return Yap_gmp_div_int_big(IntegerOfTerm(t1), t2);
#endif
default:
RERROR();
@ -354,10 +354,10 @@ p_div(Term t1, Term t2) {
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* dividing a bignum by an integer */
return Yap_gmp_div_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2));
return Yap_gmp_div_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
/* two bignums */
return Yap_gmp_div_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
return Yap_gmp_div_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
default:
@ -382,7 +382,7 @@ p_and(Term t1, Term t2) {
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)));
return Yap_gmp_and_int_big(IntegerOfTerm(t1),t2);
#endif
default:
RERROR();
@ -395,10 +395,10 @@ p_and(Term t1, Term t2) {
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* anding a bignum with an integer is easy */
return(Yap_gmp_and_int_big(IntegerOfTerm(t2),Yap_BigIntOfTerm(t1)));
return Yap_gmp_and_int_big(IntegerOfTerm(t2),t1);
case big_int_e:
/* two bignums */
return(Yap_gmp_and_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1)));
return Yap_gmp_and_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
default:
@ -423,7 +423,7 @@ p_or(Term t1, Term t2) {
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)));
return Yap_gmp_ior_int_big(IntegerOfTerm(t1),t2);
#endif
default:
RERROR();
@ -436,10 +436,10 @@ p_or(Term t1, Term t2) {
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* anding a bignum with an integer is easy */
return(Yap_gmp_ior_int_big(IntegerOfTerm(t2),Yap_BigIntOfTerm(t1)));
return Yap_gmp_ior_int_big(IntegerOfTerm(t2),t1);
case big_int_e:
/* two bignums */
return Yap_gmp_ior_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1));
return Yap_gmp_ior_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
default:
@ -483,7 +483,7 @@ p_sll(Term t1, Term t2) {
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2));
return Yap_gmp_sll_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e:
@ -529,7 +529,7 @@ p_slr(Term t1, Term t2) {
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2));
return Yap_gmp_sll_big_int(t1, -IntegerOfTerm(t2));
case big_int_e:
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e:

85
H/eval.h
View File

@ -121,7 +121,8 @@ typedef enum {
/* op_power, */
op_gcd,
op_min,
op_max
op_max,
op_rdiv
} arith2_op;
Functor STD_PROTO(EvalArg,(Term));
@ -210,43 +211,77 @@ ETypeOfTerm(Term t)
return double_e;
if (f == FunctorLongInt)
return long_int_e;
if (f == FunctorBigInt)
if (f == FunctorBigInt) {
return big_int_e;
}
}
return db_ref_e;
}
#if USE_GMP
Term STD_PROTO(Yap_gmq_rdiv_int_int,(Int, Int));
Term STD_PROTO(Yap_gmq_rdiv_int_big,(Int, Term));
Term STD_PROTO(Yap_gmq_rdiv_big_int,(Term, Int));
Term STD_PROTO(Yap_gmq_rdiv_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_add_ints,(Int, Int));
Term STD_PROTO(Yap_gmp_sub_ints,(Int, Int));
Term STD_PROTO(Yap_gmp_mul_ints,(Int, Int));
Term STD_PROTO(Yap_gmp_sll_ints,(Int, Int));
Term STD_PROTO(Yap_gmp_add_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_sub_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_sub_big_int,(MP_INT *, Int));
Term STD_PROTO(Yap_gmp_mul_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_div_big_int,(MP_INT *, Int));
Term STD_PROTO(Yap_gmp_and_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_ior_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_sll_big_int,(MP_INT *, Int));
Term STD_PROTO(Yap_gmp_add_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_sub_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_mul_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_div_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_and_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_ior_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_mod_big_big,(MP_INT *, MP_INT *));
Term STD_PROTO(Yap_gmp_mod_big_int,(MP_INT *, Int));
Term STD_PROTO(Yap_gmp_mod_int_big,(Int, MP_INT *));
Term STD_PROTO(Yap_gmp_exp_ints,(Int,Int));
Term STD_PROTO(Yap_gmp_exp_big_int,(MP_INT *,Int));
Term STD_PROTO(Yap_gmp_add_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_sub_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_sub_big_int,(Term, Int));
Term STD_PROTO(Yap_gmp_mul_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_div_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_div_big_int,(Term, Int));
Term STD_PROTO(Yap_gmp_fdiv_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_fdiv_big_int,(Term, Int));
Term STD_PROTO(Yap_gmp_and_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_ior_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_xor_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_sll_big_int,(Term, Int));
Term STD_PROTO(Yap_gmp_add_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_sub_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_mul_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_div_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_fdiv_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_and_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_ior_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_xor_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_mod_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_mod_big_int,(Term, Int));
Term STD_PROTO(Yap_gmp_mod_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_rem_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_rem_big_int,(Term, Int));
Term STD_PROTO(Yap_gmp_rem_int_big,(Int, Term));
Term STD_PROTO(Yap_gmp_exp_int_int,(Int,Int));
Term STD_PROTO(Yap_gmp_exp_int_big,(Int,Term));
Term STD_PROTO(Yap_gmp_exp_big_int,(Term,Int));
Term STD_PROTO(Yap_gmp_exp_big_big,(Term,Term));
Term STD_PROTO(Yap_gmp_gcd_int_big,(Int,Term));
Term STD_PROTO(Yap_gmp_gcd_big_big,(Term,Term));
Term STD_PROTO(Yap_gmp_big_from_64bits,(YAP_LONG_LONG));
Term STD_PROTO(Yap_gmp_add_float_big,(Float, MP_INT *));
Term STD_PROTO(Yap_gmp_sub_float_big,(Float, MP_INT *));
Term STD_PROTO(Yap_gmp_sub_big_float,(MP_INT *, Float));
Term STD_PROTO(Yap_gmp_mul_float_big,(Float, MP_INT *));
Float STD_PROTO(Yap_gmp_to_float,(Term));
Term STD_PROTO(Yap_gmp_add_float_big,(Float, Term));
Term STD_PROTO(Yap_gmp_sub_float_big,(Float, Term));
Term STD_PROTO(Yap_gmp_sub_big_float,(Term, Float));
Term STD_PROTO(Yap_gmp_mul_float_big,(Float, Term));
Term STD_PROTO(Yap_gmp_fdiv_float_big,(Float, Term));
Term STD_PROTO(Yap_gmp_fdiv_big_float,(Term, Float));
int STD_PROTO(Yap_gmp_cmp_big_int,(Term, Int));
#define Yap_gmp_cmp_int_big(I, T) (-Yap_gmp_cmp_big_int(T, I))
int STD_PROTO(Yap_gmp_cmp_big_float,(Term, Float));
#define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D))
int STD_PROTO(Yap_gmp_cmp_big_big,(Term, Term));
Term STD_PROTO(Yap_gmp_neg_int,(Int));
Term STD_PROTO(Yap_gmp_neg_big,(Term));
Term STD_PROTO(Yap_gmp_unot_big,(Term));
#endif
inline EXTERN Term Yap_Mk64IntegerTerm(YAP_LONG_LONG);