klisp

commit ba3e6bebfcb7f348fb380665a25ee68ed38a44d3
parent 723f1354e3c8a81f16b01fd69f05ad52518039e6
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat, 23 Apr 2011 18:00:03 -0300

Added support for rationals to abs, negative? & positive?.

Diffstat:
M
src/kgnumbers.c
 | 
8
++++++++
M
src/krational.c
 | 
34
+++++++++++++++++++++++++++++++---

2 files changed, 39 insertions(+), 3 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -258,6 +258,10 @@ TValue knum_abs(klisp_State *K, TValue n)
 	kensure_bigint(n); 
 	return kbigint_abs(K, n);
     }
+    case K_TBIGRAT: {
+	kensure_bigrat(n); 
+	return kbigrat_abs(K, n);
+    }
     case K_TEINF:
 	return KEPINF;
     default:
@@ -720,6 +724,8 @@ bool kpositivep(TValue n)
 	return ivalue(n) > 0;
     case K_TBIGINT:
 	return kbigint_positivep(n);
+    case K_TBIGRAT:
+	return kbigrat_positivep(n);
     default:
 	/* shouldn't happen */
 	assert(0);
@@ -735,6 +741,8 @@ bool knegativep(TValue n)
 	return ivalue(n) < 0;
     case K_TBIGINT:
 	return kbigint_negativep(n);
+    case K_TBIGRAT:
+	return kbigrat_negativep(n);
     default:
 	/* shouldn't happen */
 	assert(0);
diff --git a/src/krational.c b/src/krational.c
@@ -71,10 +71,13 @@ 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)
 {
-    TValue copy = kbigrat_new(K, false, 0, 1);
+    TValue copy = kbigrat_make_simple(K);
     /* arguments are in reverse order with respect to mp_rat_copy */
     UNUSED(mp_rat_init_copy(K, tv2bigrat(copy), tv2bigrat(src)));
     return copy;
@@ -87,7 +90,7 @@ TValue kbigrat_copy(klisp_State *K, TValue src)
 bool krational_read(klisp_State *K, char *buf, int32_t base, TValue *out, 
 		   char **end)
 {
-    TValue res = kbigrat_new(K, false, 0, 1);
+    TValue res = kbigrat_make_simple(K);
     krooted_tvs_push(K, res);
     bool ret_val = (mp_rat_read_cstring(K, tv2bigrat(res), base, 
 					buf, end) == MP_OK);
@@ -109,7 +112,7 @@ bool krational_read(klisp_State *K, char *buf, int32_t base, TValue *out,
 bool krational_read_decimal(klisp_State *K, char *buf, int32_t base, TValue *out, 
 			    char **end)
 {
-    TValue res = kbigrat_new(K, false, 0, 1);
+    TValue res = kbigrat_make_simple(K);
     krooted_tvs_push(K, res);
     bool ret_val = (mp_rat_read_ustring(K, tv2bigrat(res), base, 
 					buf, end) == MP_OK);
@@ -183,3 +186,28 @@ bool kbigrat_gep(klisp_State *K, TValue tv_bigrat1, TValue tv_bigrat2)
     return (mp_rat_compare(K, tv2bigrat(tv_bigrat1), 
 			   tv2bigrat(tv_bigrat2)) >= 0);
 }
+
+bool kbigrat_negativep(TValue tv_bigrat)
+{
+    return (mp_rat_compare_zero(tv2bigrat(tv_bigrat)) < 0);
+}
+
+bool kbigrat_positivep(TValue tv_bigrat)
+{
+    return (mp_rat_compare_zero(tv2bigrat(tv_bigrat)) > 0);
+}
+
+/* needs the state to create a copy if negative */
+TValue kbigrat_abs(klisp_State *K, TValue tv_bigrat)
+{
+    if (kbigrat_negativep(tv_bigrat)) {
+	TValue copy = kbigrat_make_simple(K);
+	krooted_tvs_push(K, copy);
+	UNUSED(mp_rat_abs(K, tv2bigrat(tv_bigrat), tv2bigrat(copy)));
+	krooted_tvs_pop(K);
+	/* NOTE: this can never be an integer if the parameter was a bigrat */
+	return copy;
+    } else {
+	return tv_bigrat;
+    }
+}