commit bf840103262c57f0cf81fe4fcf641fb67f43bc48
parent 1d3cc6969b0644dccf778fb7f44eedcc914d9b63
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sun, 10 Apr 2011 21:55:04 -0300
Added support for bigints to <?, <=?, >? & >=? applicatives.
Diffstat:
3 files changed, 113 insertions(+), 5 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -84,11 +84,18 @@ bool knum_eqp(TValue n1, TValue n2)
}
}
+/* REFACTOR: could be just ltp and all other as calls to it
+ cf: kbigint_ltp, ... */
bool knum_ltp(TValue n1, TValue n2)
{
switch(max_ttype(n1, n2)) {
case K_TFIXINT:
return ivalue(n1) < ivalue(n2);
+ case K_TBIGINT: {
+ kensure_bigint(n1);
+ kensure_bigint(n2);
+ return kbigint_ltp(n1, n2);
+ }
case K_TEINF:
return !tv_equal(n1, n2) && (tv_equal(n1, KEMINF) ||
tv_equal(n2, KEPINF));
@@ -104,6 +111,11 @@ bool knum_lep(TValue n1, TValue n2)
switch(max_ttype(n1, n2)) {
case K_TFIXINT:
return ivalue(n1) <= ivalue(n2);
+ case K_TBIGINT: {
+ kensure_bigint(n1);
+ kensure_bigint(n2);
+ return kbigint_lep(n1, n2);
+ }
case K_TEINF:
return tv_equal(n1, n2) || tv_equal(n1, KEMINF) ||
tv_equal(n2, KEPINF);
@@ -119,6 +131,11 @@ bool knum_gtp(TValue n1, TValue n2)
switch(max_ttype(n1, n2)) {
case K_TFIXINT:
return ivalue(n1) > ivalue(n2);
+ case K_TBIGINT: {
+ kensure_bigint(n1);
+ kensure_bigint(n2);
+ return kbigint_gtp(n1, n2);
+ }
case K_TEINF:
return !tv_equal(n1, n2) && (tv_equal(n1, KEPINF) ||
tv_equal(n2, KEMINF));
@@ -134,6 +151,11 @@ bool knum_gep(TValue n1, TValue n2)
switch(max_ttype(n1, n2)) {
case K_TFIXINT:
return ivalue(n1) >= ivalue(n2);
+ case K_TBIGINT: {
+ kensure_bigint(n1);
+ kensure_bigint(n2);
+ return kbigint_ltp(n1, n2);
+ }
case K_TEINF:
return tv_equal(n1, n2) || tv_equal(n1, KEPINF) ||
tv_equal(n2, KEMINF);
diff --git a/src/kinteger.c b/src/kinteger.c
@@ -202,6 +202,74 @@ bool kbigint_eqp(TValue tv_bigint1, TValue tv_bigint2)
return true;
}
+bool kbigint_ltp(TValue tv_bigint1, TValue tv_bigint2)
+{
+ Bigint *bigint1 = tv2bigint(tv_bigint1);
+ Bigint *bigint2 = tv2bigint(tv_bigint2);
+
+ /* first take care of the easy sign cases */
+ if (kbigint_negp(bigint1)) {
+ if (kbigint_posp(bigint2)) {
+ return true;
+ } else {
+ /* if both are negative reverse the order to compare
+ as positive */
+ Bigint *temp = bigint1;
+ bigint1 = bigint2;
+ bigint2 = temp;
+ /* swap the tvalues just in case */
+ TValue tv_temp = tv_bigint1;
+ tv_bigint1 = tv_bigint2;
+ tv_bigint2 = tv_temp;
+ }
+ } else if (kbigint_negp(bigint2)) {
+ return false;
+ }
+
+ /* the the easy size cases */
+ int32_t size1 = kbigint_size(bigint1);
+ int32_t size2 = kbigint_size(bigint2);
+
+ if (size1 < size2)
+ return true;
+ else if (size1 > size2)
+ return false;
+
+ /* size and sign equal, iterate in big endian mode */
+ bind_iter(iter1, bigint1, true);
+ bind_iter(iter2, bigint2, true);
+
+ while(iter_has_next(iter1) && iter_has_next(iter2)) {
+ uint32_t digit1 = iter_next(iter1);
+ uint32_t digit2 = iter_next(iter2);
+ if (digit1 < digit2)
+ return true;
+ else if (digit1 > digit2)
+ return false;
+ /* if equal we keep comparing */
+ }
+
+ return false;
+}
+
+bool kbigint_lep(TValue tv_bigint1, TValue tv_bigint2)
+{
+ /* a <= b == !(a > b) == !(b < a) */
+ return !kbigint_ltp(tv_bigint2, tv_bigint1);
+}
+
+bool kbigint_gtp(TValue tv_bigint1, TValue tv_bigint2)
+{
+ /* a > b == (b < a) */
+ return kbigint_ltp(tv_bigint2, tv_bigint1);
+}
+
+bool kbigint_gep(TValue tv_bigint1, TValue tv_bigint2)
+{
+ /* a >= b == !(a < b) */
+ return !kbigint_ltp(tv_bigint1, tv_bigint2);
+}
+
bool kbigint_negativep(TValue tv_bigint)
{
return kbigint_negp(tv2bigint(tv_bigint));
@@ -209,6 +277,7 @@ bool kbigint_negativep(TValue tv_bigint)
/* unlike the positive? applicative this would return true on zero,
but zero is never represented as a bigint so there is no problem */
+/* XXX: but bigints constructed from fixints could be, clean this up */
bool kbigint_positivep(TValue tv_bigint)
{
return kbigint_posp(tv2bigint(tv_bigint));
diff --git a/src/kinteger.h b/src/kinteger.h
@@ -25,17 +25,29 @@ TValue kbigint_copy(klisp_State *K, TValue src);
useful for mixed operations, relatively light weight compared
to creating it in the heap and burdening the gc */
#define kbind_bigint(name, fixint) \
- int32_t (KUNIQUE_NAME(i)) = fixint; \
- BigintNode KUNIQUE_NAME(node); \
- node.val = { int64_t temp = (KUNIQUE_NAME(i)); \
- (uint32_t) (temp < 0)? -temp : temp; }; \
- node.next_xor_prev = (uintptr_t) 0; /* NULL ^ NULL: 0 */ \
+ int32_t (KUNIQUE_NAME(i)) = ivalue(fixint); \
+ Bigint_Node KUNIQUE_NAME(node); \
+ (KUNIQUE_NAME(node)).digit = ({ \
+ int64_t temp = (KUNIQUE_NAME(i)); \
+ (uint32_t) ((temp < 0)? -temp : temp); \
+ }); \
+ /* NULL ^ NULL: 0 */ \
+ (KUNIQUE_NAME(node)).next_xor_prev = (uintptr_t) 0; \
Bigint KUNIQUE_NAME(bigint); \
(KUNIQUE_NAME(bigint)).first = &(KUNIQUE_NAME(node)); \
(KUNIQUE_NAME(bigint)).last = &(KUNIQUE_NAME(node)); \
(KUNIQUE_NAME(bigint)).sign_size = (KUNIQUE_NAME(i)) < 0? -1 : 1; \
Bigint *name = &(KUNIQUE_NAME(bigint));
+/* This can be used prior to calling a bigint functions
+ to automatically convert fixints to bigints.
+ NOTE: calls to this macro should go in different lines! */
+#define kensure_bigint(n) \
+ if (ttisfixint(n)) { \
+ kbind_bigint(KUNIQUE_NAME(bint), n); \
+ n = gc2bigint(KUNIQUE_NAME(bint)); \
+ }
+
/* This is used by the reader to destructively add digits to a number
tv_bigint must be positive */
void kbigint_add_digit(klisp_State *K, TValue tv_bigint, int32_t base,
@@ -50,6 +62,11 @@ bool kbigint_has_digits(klisp_State *K, TValue tv_bigint);
bool kbigint_eqp(TValue bigint1, TValue bigint2);
+bool kbigint_ltp(TValue bigint1, TValue bigint2);
+bool kbigint_lep(TValue bigint1, TValue bigint2);
+bool kbigint_gtp(TValue bigint1, TValue bigint2);
+bool kbigint_gep(TValue bigint1, TValue bigint2);
+
bool kbigint_negativep(TValue tv_bigint);
bool kbigint_positivep(TValue tv_bigint);
