klisp

commit 999e1c70846070ad2bd95bb7587ac5141a42e9c9
parent df628c2d7effbec7fd278417a9af73b487cd9691
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 27 Apr 2011 17:49:13 -0300

Added rational support to div-and-mod.

Diffstat:
M
src/kgnumbers.c
 | 
11
+++++++++--
M
src/krational.c
 | 
58
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
src/krational.h
 | 
3
---

3 files changed, 67 insertions(+), 5 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -804,7 +804,7 @@ void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     UNUSED(denv);
 
     bind_2tp(K, name, ptree, "real", krealp, tv_n,
-	     "number", krealp, tv_d);
+	     "real", krealp, tv_d);
 
     TValue tv_div, tv_mod;
 
@@ -842,6 +842,14 @@ void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 	else
 	    tv_div = kbigint_div0_mod0(K, tv_n, tv_d, &tv_mod);
 	break;
+    case K_TBIGRAT:
+	kensure_bigrat(tv_n);
+	kensure_bigrat(tv_d);
+	if ((flags & FDIV_ZERO) == 0)
+	    tv_div = kbigrat_div_mod(K, tv_n, tv_d, &tv_mod);
+	else /* TODO */
+	    tv_div = kbigrat_div0_mod0(K, tv_n, tv_d, &tv_mod);
+	break;
     case K_TEINF:
 	if (ttiseinf(tv_n)) {
 	    klispE_throw_extra(K, name, ": non finite dividend");
@@ -1054,7 +1062,6 @@ void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     UNUSED(xparams);
     UNUSED(denv);
     /* cycles are allowed, loop counting pairs */
-    int32_t dummy; /* don't care about count of cycle pairs */
     int32_t pairs = check_typed_list(K, "lcm", "improper integer", kimp_intp, 
 				     true, ptree, NULL);
 
diff --git a/src/krational.c b/src/krational.c
@@ -189,6 +189,64 @@ TValue kbigrat_minus(klisp_State *K, TValue n1, TValue n2)
     return kbigrat_try_integer(K, res);
 }
 
+/* NOTE: n2 can't be zero, that case should be checked before calling this */
+TValue kbigrat_div_mod(klisp_State *K, TValue n1, TValue n2, TValue *res_r)
+{
+    /* NOTE: quotient is always an integer, remainder may be any rational */
+    /* the remainder is calculated as tv_r * n2 */
+    TValue tv_q = kbigint_make_simple(K);
+    krooted_tvs_push(K, tv_q);
+    TValue tv_r = kbigint_make_simple(K);
+    krooted_tvs_push(K, tv_r);
+    /* for temp values */
+    TValue tv_true_rem = kbigrat_make_simple(K);
+    krooted_tvs_push(K, tv_true_rem);
+    TValue tv_div = kbigrat_make_simple(K);
+    krooted_tvs_push(K, tv_div);
+
+    Bigrat *n = tv2bigrat(n1);
+    Bigrat *d = tv2bigrat(n2);
+
+    Bigint *q = tv2bigint(tv_q);
+    Bigint *r = tv2bigint(tv_r);
+
+    Bigrat *div = tv2bigrat(tv_div);
+    Bigrat *trem = tv2bigrat(tv_true_rem);
+
+    UNUSED(mp_rat_div(K, n, d, div));
+
+    /* Now use the integral part as the quotient and the fractional part times
+       the divisor as the remainder, but then correct the remainder so that it's
+       always positive like in kbigint_div_and_mod */
+       
+    UNUSED(mp_int_div(K, MP_NUMER_P(div), MP_DENOM_P(div), q, r));
+
+    /* NOTE: denom is positive, so div & q & r have the same sign */
+
+    /* first adjust the quotient if necessary,
+       the remainder will just fall into place after this */
+    if (mp_rat_compare_zero(n) < 0)
+	UNUSED(mp_int_add_value(K, q, mp_rat_compare_zero(d) < 0? 1 : -1, q));
+
+    UNUSED(mp_rat_sub_int(K, div, q, trem));
+    UNUSED(mp_rat_mul(K, trem, d, trem));
+
+    krooted_tvs_pop(K);
+    krooted_tvs_pop(K);
+    krooted_tvs_pop(K);
+    krooted_tvs_pop(K);
+
+    *res_r = kbigrat_try_integer(K, tv_true_rem);
+    return kbigrat_try_integer(K, tv_q);
+}
+
+TValue kbigrat_div0_mod0(klisp_State *K, TValue n1, TValue n2, TValue *res_r)
+{
+    /* TODO */
+    return KINERT;
+}
+
+
 TValue kbigrat_divided(klisp_State *K, TValue n1, TValue n2)
 {
     TValue res = kbigrat_make_simple(K);
diff --git a/src/krational.h b/src/krational.h
@@ -151,11 +151,8 @@ TValue kbigrat_times(klisp_State *K, TValue n1, TValue n2);
 TValue kbigrat_minus(klisp_State *K, TValue n1, TValue n2);
 TValue kbigrat_divided(klisp_State *K, TValue n1, TValue n2);
 
-/* TODO: Kernel allows arbitrary reals for these... will have to define */
-#if 0
 TValue kbigrat_div_mod(klisp_State *K, TValue n1, TValue n2, TValue *res_r);
 TValue kbigrat_div0_mod0(klisp_State *K, TValue n1, TValue n2, TValue *res_r);
-#endif
 
 bool kbigrat_negativep(TValue tv_bigrat);
 bool kbigrat_positivep(TValue tv_bigrat);