commit 6a422ae614b1c784cbe8a6e3408d6c1a571c5f57
parent 2fef85618d6017a883269993b109f4840f42b34f
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sun, 24 Apr 2011 09:45:40 -0300
Added numerator and denominator to the ground environment.
Diffstat:
7 files changed, 177 insertions(+), 74 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -394,6 +394,38 @@ TValue knum_lcm(klisp_State *K, TValue n1, TValue n2)
}
}
+/* GC: assumes n is rooted */
+TValue knum_numerator(klisp_State *K, TValue n)
+{
+ switch(ttype(n)) {
+ case K_TFIXINT:
+ case K_TBIGINT:
+ return n;
+ case K_TBIGRAT:
+ return kbigrat_numerator(K, n);
+/* case K_TEINF: infinities are not rational! */
+ default:
+ klispE_throw(K, "numerator: unsopported type");
+ return KINERT;
+ }
+}
+
+/* GC: assumes n is rooted */
+TValue knum_denominator(klisp_State *K, TValue n)
+{
+ switch(ttype(n)) {
+ case K_TFIXINT:
+ case K_TBIGINT:
+ return i2tv(1); /* denominator of integer is always (+)1 */
+ case K_TBIGRAT:
+ return kbigrat_denominator(K, n);
+/* case K_TEINF: infinities are not rational! */
+ default:
+ klispE_throw(K, "denominator: unsopported type");
+ return KINERT;
+ }
+}
+
/* 12.5.4 + */
void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
@@ -682,7 +714,7 @@ void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
- bind_2tp(K, name, ptree, "number", krealp, tv_n,
+ bind_2tp(K, name, ptree, "real", krealp, tv_n,
"number", krealp, tv_d);
TValue tv_div, tv_mod;
@@ -1046,3 +1078,32 @@ void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, res);
}
+
+/* 12.8.3 numerator, denominator */
+void knumerator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ UNUSED(denv);
+ UNUSED(xparams);
+
+ bind_1tp(K, "numerator", ptree, "rational", krationalp, n);
+
+ TValue res = knum_numerator(K, n);
+ kapply_cc(K, res);
+}
+
+void kdenominator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ UNUSED(denv);
+ UNUSED(xparams);
+
+ bind_1tp(K, "denominator", ptree, "rational", krationalp, n);
+
+ TValue res = knum_denominator(K, n);
+ kapply_cc(K, res);
+}
+
+/* 12.8.4 floor, ceiling, truncate, round */
+/* TODO */
+
+/* 12.8.5 rationalize, simplest-rational */
+/* TODO */
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -118,7 +118,8 @@ void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* 12.8.3 numerator, denominator */
-/* TODO */
+void knumerator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void kdenominator(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
/* 12.8.4 floor, ceiling, truncate, round */
/* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -735,15 +735,22 @@ void kinit_ground_env(klisp_State *K)
** 12.8 Rational features
*/
- /* 12.8.1 rational */
+ /* 12.8.1 rational? */
add_applicative(K, ground_env, "rational?", ftypep, 2, symbol,
p2tv(krationalp));
/* 12.8.2 / */
add_applicative(K, ground_env, "/", kdivided, 0);
+ /* 12.8.3 numerator, denominator */
+ add_applicative(K, ground_env, "numerator", knumerator, 0);
+ add_applicative(K, ground_env, "denominator", kdenominator, 0);
+
+ /* 12.8.4 floor, ceiling, truncate, round */
+ /* TODO */
+
+ /* 12.8.5 rationalize, simplest-rational */
/* TODO */
- /* complete module rational */
/*
**
diff --git a/src/kinteger.c b/src/kinteger.c
@@ -15,25 +15,6 @@
#include "kmem.h"
#include "kgc.h"
-/* This tries to convert a bigint to a fixint */
-/* XXX this doesn't need K really */
-inline TValue kbigint_try_fixint(klisp_State *K, TValue n)
-{
- UNUSED(K);
- Bigint *b = tv2bigint(n);
- if (MP_USED(b) != 1)
- return n;
-
- int64_t digit = (int64_t) *(MP_DIGITS(b));
- if (MP_SIGN(b) == MP_NEG) digit = -digit;
- if (kfit_int32_t(digit)) {
- /* n shouln't be reachable but the let the gc do its job */
- return i2tv((int32_t) digit);
- } else {
- return n;
- }
-}
-
/* It is used for reading and for creating temps and res in all operations */
/* NOTE: is uint to allow INT32_MIN as positive argument in read */
TValue kbigint_new(klisp_State *K, bool sign, uint32_t digit)
@@ -60,7 +41,7 @@ TValue kbigint_new(klisp_State *K, bool sign, uint32_t digit)
/* assumes src is rooted */
TValue kbigint_copy(klisp_State *K, TValue src)
{
- TValue copy = kbigint_new(K, false, 0);
+ TValue copy = kbigint_make_simple(K);
/* arguments are in reverse order with respect to mp_int_copy */
UNUSED(mp_int_init_copy(K, tv2bigint(copy), tv2bigint(src)));
return copy;
@@ -74,7 +55,7 @@ TValue kbigint_copy(klisp_State *K, TValue src)
bool kinteger_read(klisp_State *K, char *buf, int32_t base, TValue *out,
char **end)
{
- TValue res = kbigint_new(K, false, 0);
+ TValue res = kbigint_make_simple(K);
krooted_tvs_push(K, res);
bool ret_val = (mp_int_read_cstring(K, tv2bigint(res), base,
buf, end) == MP_OK);
@@ -136,7 +117,7 @@ bool kbigint_gep(TValue tv_bigint1, TValue tv_bigint2)
*/
TValue kbigint_plus(klisp_State *K, TValue n1, TValue n2)
{
- TValue res = kbigint_new(K, false, 0);
+ TValue res = kbigint_make_simple(K);
krooted_tvs_push(K, res);
UNUSED(mp_int_add(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res)));
krooted_tvs_pop(K);
@@ -145,7 +126,7 @@ TValue kbigint_plus(klisp_State *K, TValue n1, TValue n2)
TValue kbigint_times(klisp_State *K, TValue n1, TValue n2)
{
- TValue res = kbigint_new(K, false, 0);
+ TValue res = kbigint_make_simple(K);
krooted_tvs_push(K, res);
UNUSED(mp_int_mul(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res)));
krooted_tvs_pop(K);
@@ -154,7 +135,7 @@ TValue kbigint_times(klisp_State *K, TValue n1, TValue n2)
TValue kbigint_minus(klisp_State *K, TValue n1, TValue n2)
{
- TValue res = kbigint_new(K, false, 0);
+ TValue res = kbigint_make_simple(K);
krooted_tvs_push(K, res);
UNUSED(mp_int_sub(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res)));
krooted_tvs_pop(K);
@@ -164,9 +145,9 @@ TValue kbigint_minus(klisp_State *K, TValue n1, TValue n2)
/* NOTE: n2 can't be zero, that case should be checked before calling this */
TValue kbigint_div_mod(klisp_State *K, TValue n1, TValue n2, TValue *res_r)
{
- TValue tv_q = kbigint_new(K, false, 0);
+ TValue tv_q = kbigint_make_simple(K);
krooted_tvs_push(K, tv_q);
- TValue tv_r = kbigint_new(K, false, 0);
+ TValue tv_r = kbigint_make_simple(K);
krooted_tvs_push(K, tv_r);
Bigint *n = tv2bigint(n1);
@@ -198,9 +179,9 @@ TValue kbigint_div_mod(klisp_State *K, TValue n1, TValue n2, TValue *res_r)
TValue kbigint_div0_mod0(klisp_State *K, TValue n1, TValue n2, TValue *res_r)
{
/* GC: root bigints */
- TValue tv_q = kbigint_new(K, false, 0);
+ TValue tv_q = kbigint_make_simple(K);
krooted_tvs_push(K, tv_q);
- TValue tv_r = kbigint_new(K, false, 0);
+ TValue tv_r = kbigint_make_simple(K);
krooted_tvs_push(K, tv_r);
Bigint *n = tv2bigint(n1);
@@ -212,12 +193,12 @@ TValue kbigint_div0_mod0(klisp_State *K, TValue n1, TValue n2, TValue *res_r)
/* Adjust q & r so that -|d/2| <= r < |d/2| */
/* It seems easier to check -|d| <= 2r < |d| */
- TValue tv_two_r = kbigint_new(K, false, 0);
+ TValue tv_two_r = kbigint_make_simple(K);
krooted_tvs_push(K, tv_two_r);
Bigint *two_r = tv2bigint(tv_two_r);
/* two_r = r * 2 = r * 2^1 */
UNUSED(mp_int_mul_pow2(K, r, 1, two_r));
- TValue tv_abs_d = kbigint_new(K, false, 0);
+ TValue tv_abs_d = kbigint_make_simple(K);
krooted_tvs_push(K, tv_abs_d);
/* NOTE: this makes a copy if d >= 0 */
Bigint *abs_d = tv2bigint(tv_abs_d);
@@ -280,7 +261,7 @@ bool kbigint_evenp(TValue tv_bigint)
TValue kbigint_abs(klisp_State *K, TValue tv_bigint)
{
if (kbigint_negativep(tv_bigint)) {
- TValue copy = kbigint_new(K, false, 0);
+ TValue copy = kbigint_make_simple(K);
krooted_tvs_push(K, copy);
UNUSED(mp_int_abs(K, tv2bigint(tv_bigint), tv2bigint(copy)));
krooted_tvs_pop(K);
@@ -293,7 +274,7 @@ TValue kbigint_abs(klisp_State *K, TValue tv_bigint)
TValue kbigint_gcd(klisp_State *K, TValue n1, TValue n2)
{
- TValue res = kbigint_new(K, false, 0);
+ TValue res = kbigint_make_simple(K);
krooted_tvs_push(K, res);
UNUSED(mp_int_gcd(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res)));
krooted_tvs_pop(K);
@@ -302,7 +283,7 @@ TValue kbigint_gcd(klisp_State *K, TValue n1, TValue n2)
TValue kbigint_lcm(klisp_State *K, TValue n1, TValue n2)
{
- TValue tv_res = kbigint_new(K, false, 0);
+ TValue tv_res = kbigint_make_simple(K);
krooted_tvs_push(K, tv_res);
Bigint *res = tv2bigint(tv_res);
/* unlike in kernel, lcm in IMath can return a negative value
diff --git a/src/kinteger.h b/src/kinteger.h
@@ -15,17 +15,37 @@
#include "kstate.h"
#include "imath.h"
-/* for now used only for reading */
+/* Check to see if an int64_t fits in a int32_t */
+inline bool kfit_int32_t(int64_t n) {
+ return (n >= (int64_t) INT32_MIN && n <= (int64_t) INT32_MAX);
+}
+
+/* This tries to convert a bigint to a fixint */
+/* XXX this doesn't need K really */
+inline TValue kbigint_try_fixint(klisp_State *K, TValue n)
+{
+ UNUSED(K);
+ Bigint *b = tv2bigint(n);
+ if (MP_USED(b) != 1)
+ return n;
+
+ int64_t digit = (int64_t) *(MP_DIGITS(b));
+ if (MP_SIGN(b) == MP_NEG) digit = -digit;
+ if (kfit_int32_t(digit)) {
+ /* n shouln't be reachable but the let the gc do its job */
+ return i2tv((int32_t) digit);
+ } else {
+ return n;
+ }
+}
+
/* NOTE: is uint and has flag to allow INT32_MIN as positive argument */
TValue kbigint_new(klisp_State *K, bool sign, uint32_t digit);
-/* used in write to destructively get the digits & in bigrat */
TValue kbigint_copy(klisp_State *K, TValue src);
-/* Check to see if an int64_t fits in a int32_t */
-inline bool kfit_int32_t(int64_t n) {
- return (n >= (int64_t) INT32_MIN && n <= (int64_t) INT32_MAX);
-}
+/* macro to create the simplest bigint */
+#define kbigint_make_simple(K_) kbigint_new(K_, false, 0)
/* Create a stack allocated bigints from a fixint,
useful for mixed operations, relatively light weight compared
diff --git a/src/krational.c b/src/krational.c
@@ -17,31 +17,6 @@
#include "kmem.h"
#include "kgc.h"
-/* This tries to convert a bigrat to a fixint or a bigint */
-inline TValue kbigrat_try_integer(klisp_State *K, TValue n)
-{
- Bigrat *b = tv2bigrat(n);
-
- if (!mp_rat_is_integer(b))
- return n;
-
- /* sadly we have to repeat the code from try_fixint here... */
- Bigint *i = MP_NUMER_P(b);
- if (MP_USED(i) == 1) {
- int64_t digit = (int64_t) *(MP_DIGITS(i));
- if (MP_SIGN(i) == MP_NEG) digit = -digit;
- if (kfit_int32_t(digit))
- return i2tv((int32_t) digit);
- /* else fall through */
- }
- /* should alloc a bigint */
- /* GC: n may not be rooted */
- krooted_tvs_push(K, n);
- TValue copy = kbigint_copy(K, gc2bigint(i));
- krooted_tvs_pop(K);
- return copy;
-}
-
/* used for res & temps in operations */
/* NOTE: This is to be called only with already reduced values */
TValue kbigrat_new(klisp_State *K, bool sign, uint32_t num,
@@ -71,9 +46,6 @@ TValue kbigrat_new(klisp_State *K, bool sign, uint32_t num,
return gc2bigrat(new_bigrat);
}
-/* macro to create the simplest rational */
-#define kbigrat_make_simple(K_) kbigrat_new(K_, false, 0, 1)
-
/* assumes src is rooted */
TValue kbigrat_copy(klisp_State *K, TValue src)
{
@@ -236,6 +208,7 @@ bool kbigrat_positivep(TValue tv_bigrat)
return (mp_rat_compare_zero(tv2bigrat(tv_bigrat)) > 0);
}
+/* GC: These assume tv_bigrat is rooted */
/* needs the state to create a copy if negative */
TValue kbigrat_abs(klisp_State *K, TValue tv_bigrat)
{
@@ -250,3 +223,37 @@ TValue kbigrat_abs(klisp_State *K, TValue tv_bigrat)
return tv_bigrat;
}
}
+
+TValue kbigrat_numerator(klisp_State *K, TValue tv_bigrat)
+{
+ int32_t fnum = 0;
+ Bigrat *bigrat = tv2bigrat(tv_bigrat);
+ if (mp_rat_to_ints(bigrat, &fnum, NULL) == MP_OK)
+ return i2tv(fnum);
+ else {
+ TValue copy = kbigint_make_simple(K);
+ krooted_tvs_push(K, copy);
+ UNUSED(mp_rat_numer(K, bigrat, tv2bigint(copy)));
+ krooted_tvs_pop(K);
+ /* NOTE: may still be a fixint because mp_rat_to_ints fails if
+ either numer or denom isn't a fixint */
+ return kbigint_try_fixint(K, copy);
+ }
+}
+
+TValue kbigrat_denominator(klisp_State *K, TValue tv_bigrat)
+{
+ int32_t fden = 0;
+ Bigrat *bigrat = tv2bigrat(tv_bigrat);
+ if (mp_rat_to_ints(bigrat, NULL, &fden) == MP_OK)
+ return i2tv(fden);
+ else {
+ TValue copy = kbigint_make_simple(K);
+ krooted_tvs_push(K, copy);
+ UNUSED(mp_rat_denom(K, bigrat, tv2bigint(copy)));
+ krooted_tvs_pop(K);
+ /* NOTE: may still be a fixint because mp_rat_to_ints fails if
+ either numer or denom isn't a fixint */
+ return kbigint_try_fixint(K, copy);
+ }
+}
diff --git a/src/krational.h b/src/krational.h
@@ -18,7 +18,30 @@
/* TEMP: for now we only implement bigrats (memory allocated) */
-/* TEMP: we'll see about reading & writing... */
+/* This tries to convert a bigrat to a fixint or a bigint */
+inline TValue kbigrat_try_integer(klisp_State *K, TValue n)
+{
+ Bigrat *b = tv2bigrat(n);
+
+ if (!mp_rat_is_integer(b))
+ return n;
+
+ /* sadly we have to repeat the code from try_fixint here... */
+ Bigint *i = MP_NUMER_P(b);
+ if (MP_USED(i) == 1) {
+ int64_t digit = (int64_t) *(MP_DIGITS(i));
+ if (MP_SIGN(i) == MP_NEG) digit = -digit;
+ if (kfit_int32_t(digit))
+ return i2tv((int32_t) digit);
+ /* else fall through */
+ }
+ /* should alloc a bigint */
+ /* GC: n may not be rooted */
+ krooted_tvs_push(K, n);
+ TValue copy = kbigint_copy(K, gc2bigint(i));
+ krooted_tvs_pop(K);
+ return copy;
+}
/* used in reading and for res & temps in operations */
TValue kbigrat_new(klisp_State *K, bool sign, uint32_t num,
@@ -27,6 +50,9 @@ TValue kbigrat_new(klisp_State *K, bool sign, uint32_t num,
/* used in write to destructively get the digits */
TValue kbigrat_copy(klisp_State *K, TValue src);
+/* macro to create the simplest rational */
+#define kbigrat_make_simple(K_) kbigrat_new(K_, false, 0, 1)
+
/* Create a stack allocated bigrat from a bigint,
useful for mixed operations, relatively light weight compared
to creating it in the heap and burdening the gc */
@@ -137,8 +163,8 @@ bool kbigrat_positivep(TValue tv_bigrat);
/* needs the state to create a copy if negative */
TValue kbigrat_abs(klisp_State *K, TValue tv_bigrat);
-bool kbigrat_numerator(TValue tv_bigrat);
-bool kbigrat_denominator(TValue tv_bigrat);
+TValue kbigrat_numerator(klisp_State *K, TValue tv_bigrat);
+TValue kbigrat_denominator(klisp_State *K, TValue tv_bigrat);
/* TODO implement these */
#if 0
