klisp

commit bbd5e8ed9ef5381ed98a3660df03c2c5e0f24b44
parent b518f806585494f034d9304fea3ae573be1639c7
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue, 12 Apr 2011 16:35:53 -0300

Added bigint support to the + applicative. Refactored kplus to use new function knum_plus.

Diffstat:
M
src/kgnumbers.c
 | 
110
++++++++++++++++++++++++++++++++-----------------------------------------------
M
src/kinteger.c
 | 
8
++++++++

2 files changed, 53 insertions(+), 65 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -108,13 +108,41 @@ bool knum_lep(TValue n1, TValue n2) { return !knum_ltp(n2, n1); }
 bool knum_gtp(TValue n1, TValue n2) { return knum_ltp(n2, n1); }
 bool knum_gep(TValue n1, TValue n2) { return !knum_ltp(n1, n2); }
 
-/*
-** REFACTOR: all of *, -, and + should be refactored
-** this will probably happen when bignums are introduced
-** the idea is to have generic binary +, -, * and /, maybe
-** inlineable. That would clear up all the border cases
-** like infinities that are obscuring the code.
-**/
+/* REFACTOR/MAYBE: add small inlineable plus that
+   first tries fixint addition and if that fails calls knum_plus */
+
+/* May throw an error */
+TValue knum_plus(klisp_State *K, TValue n1, TValue n2)
+{
+    switch(max_ttype(n1, n2)) {
+    case K_TFIXINT: {
+	int64_t res = (int64_t) ivalue(n1) + (int64_t) ivalue(n2);
+	if (res >= (int64_t) INT32_MIN &&
+	    res <= (int64_t) INT32_MAX) {
+	    return i2tv((int32_t) res);
+	} /* else fall through */
+    }
+    case K_TBIGINT: {
+	kensure_bigint(n1);
+	kensure_bigint(n2);
+	return kbigint_plus(K, n1, n2);
+    }
+    case K_TEINF:
+	if (!ttiseinf(n1))
+	    return n2;
+	else if (!ttiseinf(n2))
+	    return n1;
+	if (tv_equal(n1, n2))
+	    return n1;
+	else {
+	    klispE_throw(K, "+: no primary value");
+	    return KINERT;
+	}
+    default:
+	klispE_throw(K, "+: unsopported type");
+	return KINERT;
+    }
+}
 
 /* 12.5.4 + */
 void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
@@ -131,97 +159,49 @@ void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 
     /* first the acyclic part */
     TValue ares = i2tv(0);
-    int32_t accum = 0;
-    bool seen_infinity = false;
     TValue tail = ptree;
 
     while(apairs--) {
 	TValue first = kcar(tail);
 	tail = kcdr(tail);
 
-	if (ttiseinf(first)) {
-	    if (seen_infinity && !tv_equal(first, ares)) {
-		/* report: #e+infinity + #e-infinity has no primary value */
-		klispE_throw(K, "+: result has no primary value");
-		return;
-	    } else {
-		/* record which infinity we have seen */
-		seen_infinity = true;
-		ares = first;
-	    }
-	} else if (!seen_infinity) {
-	    accum += ivalue(first);
-	}
+	/* may throw an exception */
+	ares = knum_plus(K, ares, first);
     }
 
-    if (!seen_infinity)
-	ares = i2tv(accum);
-
     /* next the cyclic part */
     TValue cres = i2tv(0);
 
     if (cpairs == 0) {
+	/* speed things up if there is no cycle */
 	res = ares;
     } else {
 	bool all_zero = true;
 
-	seen_infinity = false;
-	accum = 0;
-
 	while(cpairs--) {
 	    TValue first = kcar(tail);
 	    tail = kcdr(tail);
 
 	    all_zero = all_zero && kfast_zerop(first);
 
-	    if (ttiseinf(first)) {
-		if (seen_infinity && !tv_equal(first, cres)) {
-		    /* report: #e+infinity + #e-infinity has no primary value */
-		    klispE_throw(K, "+: result has no primary value");
-		    return;
-		} else {
-		    /* record which infinity we have seen */
-		    seen_infinity = true;
-		    cres = first;
-		}
-	    } else if (!seen_infinity) {
-		accum += ivalue(first);
-	    }
-	}
-
-	if (!seen_infinity) {
-	    if (accum == 0)  {
-		if (!all_zero) {
-		    /* report */
-		    klispE_throw(K, "+: result has no primary value");
-		    return;
-		} else {
-		    cres = i2tv(accum);
-		}
-	    } else {
-		cres = accum < 0? KEMINF : KEPINF;
-	    }
+	    cres = knum_plus(K, cres, first);
 	}
 
-	if (ttiseinf(ares)) {
-	    if (!ttiseinf(cres) || tv_equal(ares, cres))
-		res = ares;
-	    else {
+	if (kfast_zerop(cres)) {
+	    if (!all_zero) {
 		/* report */
 		klispE_throw(K, "+: result has no primary value");
 		return;
 	    }
 	} else {
-	    if (ttiseinf(cres))
-		res = cres;
-	    else 
-		res = i2tv(ivalue(ares) + ivalue(cres));
+	    cres = knegativep(cres)? KEMINF : KEPINF;
 	}
-    } 
+
+	res = knum_plus(K, ares, cres);
+    }
     kapply_cc(K, res);
 }
 
-
 /* 12.5.5 * */
 void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 {
diff --git a/src/kinteger.c b/src/kinteger.c
@@ -93,6 +93,7 @@ int32_t kbigint_print_size(TValue tv_bigint, int32_t base)
     return mp_int_string_len(tv2bigint(tv_bigint), base);
 }
 
+/* Interface for kgnumbers */
 bool kbigint_eqp(TValue tv_bigint1, TValue tv_bigint2)
 {
     return (mp_int_compare(tv2bigint(tv_bigint1), 
@@ -123,6 +124,13 @@ bool kbigint_gep(TValue tv_bigint1, TValue tv_bigint2)
 			   tv2bigint(tv_bigint2)) >= 0);
 }
 
+TValue kbigint_plus(klisp_State *K, TValue n1, TValue n2)
+{
+    TValue res = kbigint_new(K, false, 0);
+    UNUSED(mp_int_add(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res)));
+    return res;
+}
+
 bool kbigint_negativep(TValue tv_bigint)
 {
     return (mp_int_compare_zero(tv2bigint(tv_bigint)) < 0);