klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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:
Msrc/kgnumbers.c | 110++++++++++++++++++++++++++++++++-----------------------------------------------
Msrc/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);