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

support 2^2 is 4 and not 4.0: complicated if we have to deal with bignums.

Browse Source
This commit is contained in:
Vitor Santos Costa 2009-04-24 19:03:00 -05:00
parent e3aeb48af6
commit 2503805aff
10 changed files with 185 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
C/arith2.c
View File

@ -572,6 +572,133 @@ p_power(Term t1, Term t2)
RERROR();
}
/* next function is adapted from:
Inline C++ integer exponentiation routines
Version 1.01
Copyright (C) 1999-2004 John C. Bowman <bowman@math.ualberta.ca>
*/
static inline Int
ipow(Int x, Int p)
{
if (p == 0) return 1L;
if (x == 0 && p > 0) return 0L;
if(p < 0)
return (-p % 2) ? x : 1L;
Int r = 1L;
for(;;) {
if(p & 1) {
if (mul_overflow((r*x), r, x)) {
return 0;
}
r *= x;
}
if((p >>= 1) == 0) return r;
if (mul_overflow((x*x), x, x)) {
return 0;
}
x *= x;
}
}
/*
power: x^y
*/
static Term
p_exp(Term t1, Term t2)
{
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int pow = ipow(i1,i2);
#ifdef USE_GMP
/* two integers */
if (i1 && !pow) {
/* overflow */
return Yap_gmp_exp_ints(i1, i2);
}
#endif
RINT(pow);
}
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(pow(fl1,fl2));
}
#ifdef USE_GMP
case big_int_e:
{
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
P = (yamop *)FAILCODE;
RERROR();
}
#endif
case db_ref_e:
RERROR();
}
break;
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float / integer */
{
Int i2 = IntegerOfTerm(t2);
RFLOAT(pow(FloatOfTerm(t1),i2));
}
case double_e:
{
Float f2 = FloatOfTerm(t2);
RFLOAT(pow(FloatOfTerm(t1),f2));
}
#ifdef USE_GMP
case big_int_e:
{
Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
P = (yamop *)FAILCODE;
RERROR();
}
#endif
case db_ref_e:
RERROR();
}
break;
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
{
Int i = IntegerOfTerm(t2);
return Yap_gmp_exp_big_int(Yap_BigIntOfTerm(t1),i);
}
case big_int_e:
/* two bignums, makes no sense */
//
Yap_Error(RESOURCE_ERROR_HUGE_INT, t1, "^/2");
P = (yamop *)FAILCODE;
RERROR();
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl));
}
case db_ref_e:
RERROR();
}
#endif
case db_ref_e:
RERROR();
}
RERROR();
}
static Int
gcd(Int m11,Int m21)
{
@ -1019,8 +1146,10 @@ eval2(Int fi, Term t1, Term t2) {
return p_xor(t1, t2);
case op_atan2:
return p_atan2(t1, t2);
case op_power:
case op_power2:
return p_power(t1, t2);
case op_power:
return p_exp(t1, t2);
case op_gcd:
return p_gcd(t1, t2);
case op_min:
@ -1053,9 +1182,9 @@ static InitBinEntry InitBinTab[] = {
/* C-Prolog exponentiation */
{"^", op_power},
/* ISO-Prolog exponentiation */
{"**", op_power},
{"**", op_power2},
/* Quintus exponentiation */
{"exp", op_power},
{"exp", op_power2},
{"gcd", op_gcd},
{"min", op_min},
{"max", op_max}

14
C/errors.c
View File

@ -1357,6 +1357,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
break;
case RESOURCE_ERROR_HUGE_INT:
{
int i;
Term ti[1];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomHugeInt);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case SYNTAX_ERROR:
{
int i;

28
C/gmp_support.c
View File

@ -292,6 +292,34 @@ Yap_gmp_mul_float_big(Float d, MP_INT *b)
return MkFloatTerm(d*mpz_get_d(b));
}
Term
Yap_gmp_exp_ints(Int i1, Int i2)
{
MP_INT new;
mpz_init_set_si(&new, i1);
mpz_pow_ui (&new, &new, (unsigned long int)i2);
return Yap_MkBigIntTerm(&new);
}
Term
Yap_gmp_exp_big_int(MP_INT *b, Int i)
{
MP_INT new;
if (b > 0) {
mpz_init(&new);
mpz_pow_ui (&new, b, (unsigned long int)i);
} else {
MP_INT new;
if (b==0) return MkIntTerm(1);
mpz_init_set_si(&new, i);
mpz_powm (&new, b, &new, b);
}
return Yap_MkBigIntTerm(&new);
}
#endif

1
H/Yap.h
View File

@ -478,6 +478,7 @@ typedef enum
REPRESENTATION_ERROR_CHARACTER,
REPRESENTATION_ERROR_CHARACTER_CODE,
REPRESENTATION_ERROR_MAX_ARITY,
RESOURCE_ERROR_HUGE_INT,
RESOURCE_ERROR_MAX_THREADS,
RESOURCE_ERROR_MEMORY,
RETRY_COUNTER_UNDERFLOW,

3
H/eval.h
View File

@ -108,6 +108,7 @@ typedef enum {
op_power,
/* ISO-Prolog exponentiation */
/* op_power, */
op_power2,
/* Quintus exponentiation */
/* op_power, */
op_gcd,
@ -205,6 +206,8 @@ 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_exp_ints,(Int,Int));
Term STD_PROTO(Yap_gmp_exp_big_int,(MP_INT *,Int));

1
H/iatoms.h
View File

@ -25,6 +25,7 @@
AtomB = Yap_FullLookupAtom("$last_choice_pt");
AtomBatched = Yap_LookupAtom("batched");
AtomBetween = Yap_LookupAtom("between");
AtomHugeInt = Yap_LookupAtom("huge_int");
AtomBinaryStream = Yap_LookupAtom("binary_stream");
AtomBraces = Yap_LookupAtom("{}");
AtomBreak = Yap_FullLookupAtom("$break");

1
H/ratoms.h
View File

@ -25,6 +25,7 @@
AtomB = AtomAdjust(AtomB);
AtomBatched = AtomAdjust(AtomBatched);
AtomBetween = AtomAdjust(AtomBetween);
AtomHugeInt = AtomAdjust(AtomHugeInt);
AtomBinaryStream = AtomAdjust(AtomBinaryStream);
AtomBraces = AtomAdjust(AtomBraces);
AtomBreak = AtomAdjust(AtomBreak);

2
H/tatoms.h
View File

@ -52,6 +52,8 @@
#define AtomBatched Yap_heap_regs->AtomBatched_
Atom AtomBetween_;
#define AtomBetween Yap_heap_regs->AtomBetween_
Atom AtomHugeInt_;
#define AtomHugeInt Yap_heap_regs->AtomHugeInt_
Atom AtomBinaryStream_;
#define AtomBinaryStream Yap_heap_regs->AtomBinaryStream_
Atom AtomBraces_;

1
misc/ATOMS
View File

@ -34,6 +34,7 @@ A Attributes N "attributes"
A B F "$last_choice_pt"
A Batched N "batched"
A Between N "between"
A HugeInt N "huge_int"
A BinaryStream N "binary_stream"
A Braces N "{}"
A Break F "$break"

2
pl/messages.yap
View File

@ -242,6 +242,8 @@ system_message(error(representation_error(character_code), Where)) -->
[ 'REPRESENTATION ERROR- ~w: expected character code' - [Where] ].
system_message(error(representation_error(max_arity), Where)) -->
[ 'REPRESENTATION ERROR- ~w: number too big' - [Where] ].
system_message(error(resource_error(huge_int), Where)) -->
[ 'RESOURCE ERROR- too large an integer in absolute value' - [Where] ].
system_message(error(resource_error(threads), Where)) -->
[ 'RESOURCE ERROR- too many open threads' - [Where] ].
system_message(error(resource_error(memory), Where)) -->