klisp

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

commit d19e10b9bc8e5529d8a84587955828162e3c0cec
parent d142d111a8b00b69c626f4d28bc53358efae0c7f
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue, 22 Mar 2011 17:06:24 -0300

Made + accept any number of arguments.

Diffstat:
Msrc/kgnumbers.c | 111++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------
1 file changed, 90 insertions(+), 21 deletions(-)

diff --git a/src/kgnumbers.c b/src/kgnumbers.c @@ -120,35 +120,104 @@ void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) { UNUSED(denv); UNUSED(xparams); + /* cycles are allowed, loop counting pairs */ + int32_t cpairs; + int32_t pairs = check_typed_list(K, "+", "number", knumberp, true, + ptree, &cpairs); + int32_t apairs = pairs - cpairs; - bind_2tp(K, "+", ptree, "number", knumberp, n1, "number", knumberp, n2); + TValue res; - switch(max_ttype(n1, n2)) { - case K_TFIXINT: { - int32_t i1 = ivalue(n1); - int32_t i2 = ivalue(n2); - /* TODO: check for overflow and create bigint */ - kapply_cc(K, i2tv(i1+i2)); - } - case K_TEINF: { - if (ttiseinf(n1) && ttiseinf(n2)) { - if (tv_equal(n1, n2)) { - kapply_cc(K, n1); + /* 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 { - /* TEMP: we don't have reals with no prim value yet */ - /* also no strict arithmetic variable for now */ + /* record which infinity we have seen */ + seen_infinity = true; + ares = first; + } + } else if (!seen_infinity) { + accum += ivalue(first); + } + } + + if (!seen_infinity) + ares = i2tv(accum); + + /* next the acyclic part */ + TValue cres = i2tv(0); + + if (cpairs == 0) { + 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; + } + } + + if (ttiseinf(ares)) { + if (!ttiseinf(cres) || tv_equal(ares, cres)) + res = ares; + else { + /* report */ klispE_throw(K, "+: result has no primary value"); return; } } else { - kapply_cc(K, ttiseinf(n1)? n1 : n2); + if (ttiseinf(cres)) + res = cres; + else + res = i2tv(ivalue(ares) + ivalue(cres)); } - } - default: - /* shouldn't happen */ - assert(0); - return; - } + } + kapply_cc(K, res); }