diff options
| -rw-r--r-- | ChangeLog | 16 | ||||
| -rw-r--r-- | arith.c | 112 | ||||
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 34 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | txr.1 | 4 |
6 files changed, 135 insertions, 34 deletions
@@ -1,5 +1,21 @@ 2011-12-11 Kaz Kylheku <kaz@kylheku.com> + * arith.c (zerop, gt, lt, ge, le): Functions from lib.c reimplemented + with bignum support. + + * eval.c (eval_init): Added bignump and zerop as intrinsic function. + Renamed numberp to fixnump. + + * lib.c (zerop, gt, lt, ge, le): Functions removed. + (numeq): Unused function removed. + + * lib.h (numeq): Declaration removed. + + * txr.1: Sections for zerop and bignump created. Changed reference + to numberp to fixnump. + +2011-12-11 Kaz Kylheku <kaz@kylheku.com> + * arith.c (plus, mul): Plugged mpi_int memory leaks. (trunc): Plugged memory leaks. Straightened out semantics with negative modulus. (Residue comes out negative). @@ -689,6 +689,118 @@ val mod(val anum, val bnum) abort(); } +val zerop(val num) +{ + if (num == zero) + return t; + + if (!fixnump(num) && !bignump(num)) + uw_throwf(error_s, lit("zerof: ~s is not a number"), num, nao); + return nil; +} + +val gt(val anum, val bnum) +{ + int tag_a = tag(anum); + int tag_b = tag(bnum); + + switch (TAG_PAIR(tag_a, tag_b)) { + case TAG_PAIR(TAG_NUM, TAG_NUM): + return c_num(anum) > c_num(bnum) ? t : nil; + case TAG_PAIR(TAG_NUM, TAG_PTR): + type_check(bnum, BGNUM); + return mp_cmp_z(mp(bnum)) == MP_LT ? t : nil; + case TAG_PAIR(TAG_PTR, TAG_NUM): + type_check(anum, BGNUM); + return mp_cmp_z(mp(anum)) == MP_GT ? t : nil; + case TAG_PAIR(TAG_PTR, TAG_PTR): + type_check(anum, BGNUM); + return mp_cmp(mp(anum), mp(bnum)) == MP_GT ? t : nil; + } + + uw_throwf(error_s, lit("gt: invalid operands ~s ~s"), anum, bnum, nao); + abort(); +} + +val lt(val anum, val bnum) +{ + int tag_a = tag(anum); + int tag_b = tag(bnum); + + switch (TAG_PAIR(tag_a, tag_b)) { + case TAG_PAIR(TAG_NUM, TAG_NUM): + return c_num(anum) < c_num(bnum) ? t : nil; + case TAG_PAIR(TAG_NUM, TAG_PTR): + type_check(bnum, BGNUM); + return mp_cmp_z(mp(bnum)) == MP_GT ? t : nil; + case TAG_PAIR(TAG_PTR, TAG_NUM): + type_check(anum, BGNUM); + return mp_cmp_z(mp(anum)) == MP_LT ? t : nil; + case TAG_PAIR(TAG_PTR, TAG_PTR): + type_check(anum, BGNUM); + return mp_cmp(mp(anum), mp(bnum)) == MP_LT ? t : nil; + } + + uw_throwf(error_s, lit("lt: invalid operands ~s ~s"), anum, bnum, nao); + abort(); +} + +val ge(val anum, val bnum) +{ + int tag_a = tag(anum); + int tag_b = tag(bnum); + + switch (TAG_PAIR(tag_a, tag_b)) { + case TAG_PAIR(TAG_NUM, TAG_NUM): + return c_num(anum) >= c_num(bnum) ? t : nil; + case TAG_PAIR(TAG_NUM, TAG_PTR): + type_check(bnum, BGNUM); + return mp_cmp_z(mp(bnum)) == MP_LT ? t : nil; + case TAG_PAIR(TAG_PTR, TAG_NUM): + type_check(anum, BGNUM); + return mp_cmp_z(mp(anum)) == MP_GT ? t : nil; + case TAG_PAIR(TAG_PTR, TAG_PTR): + type_check(anum, BGNUM); + switch (mp_cmp(mp(anum), mp(bnum))) { + case MP_GT: case MP_EQ: + return t; + default: + return nil; + } + } + + uw_throwf(error_s, lit("ge: invalid operands ~s ~s"), anum, bnum, nao); + abort(); +} + +val le(val anum, val bnum) +{ + int tag_a = tag(anum); + int tag_b = tag(bnum); + + switch (TAG_PAIR(tag_a, tag_b)) { + case TAG_PAIR(TAG_NUM, TAG_NUM): + return c_num(anum) <= c_num(bnum) ? t : nil; + case TAG_PAIR(TAG_NUM, TAG_PTR): + type_check(bnum, BGNUM); + return mp_cmp_z(mp(bnum)) == MP_GT ? t : nil; + case TAG_PAIR(TAG_PTR, TAG_NUM): + type_check(anum, BGNUM); + return mp_cmp_z(mp(anum)) == MP_LT ? t : nil; + case TAG_PAIR(TAG_PTR, TAG_PTR): + type_check(anum, BGNUM); + switch (mp_cmp(mp(anum), mp(bnum))) { + case MP_LT: case MP_EQ: + return t; + default: + return nil; + } + } + + uw_throwf(error_s, lit("lt: invalid operands ~s ~s"), anum, bnum, nao); + abort(); +} + void arith_init(void) { mp_init(&NUM_MAX_MP); @@ -1157,7 +1157,9 @@ void eval_init(void) reg_fun(intern(lit("trunc"), user_package), func_n2(trunc)); reg_fun(intern(lit("mod"), user_package), func_n2(mod)); reg_fun(intern(lit("fixnump"), user_package), func_n1(fixnump)); + reg_fun(intern(lit("bignump"), user_package), func_n1(bignump)); + reg_fun(intern(lit("zerop"), user_package), func_n1(zerop)); reg_fun(intern(lit(">"), user_package), func_n1v(gtv)); reg_fun(intern(lit("<"), user_package), func_n1v(ltv)); reg_fun(intern(lit(">="), user_package), func_n1v(gev)); @@ -857,31 +857,6 @@ val mulv(val nlist) return reduce_left(func_n2(mul), cdr(nlist), car(nlist), nil); } -val zerop(val num) -{ - return c_num(num) == 0 ? t : nil; -} - -val gt(val anum, val bnum) -{ - return c_num(anum) > c_num(bnum) ? t : nil; -} - -val lt(val anum, val bnum) -{ - return c_num(anum) < c_num(bnum) ? t : nil; -} - -val ge(val anum, val bnum) -{ - return c_num(anum) >= c_num(bnum) ? t : nil; -} - -val le(val anum, val bnum) -{ - return c_num(anum) <= c_num(bnum) ? t : nil; -} - val gtv(val first, val rest) { val iter; @@ -938,19 +913,14 @@ val lev(val first, val rest) return t; } -val numeq(val anum, val bnum) -{ - return c_num(anum) == c_num(bnum) ? t : nil; -} - val max2(val anum, val bnum) { - return c_num(anum) > c_num(bnum) ? anum : bnum; + return if3(gt(anum, bnum), anum, bnum); } val min2(val anum, val bnum) { - return c_num(anum) < c_num(bnum) ? anum : bnum; + return if3(lt(anum, bnum), anum, bnum); } val maxv(val first, val rest) @@ -381,7 +381,6 @@ val gtv(val first, val rest); val ltv(val first, val rest); val gev(val first, val rest); val lev(val first, val rest); -val numeq(val anum, val bnum); val max2(val anum, val bnum); val min2(val anum, val bnum); val maxv(val first, val rest); @@ -4809,7 +4809,9 @@ The following are Lisp functions and variables built-in to TXR. .SS Arithmetic functions +, -, *, trunc, mod -.SS Function numberp +.SS Functions fixnump, bignump + +.SS Function zerop .SS Relational functions >, <, >= and <= |