klisp

commit f5468caaf5f5aad02fb5b71204cab9880a6d7c98
parent e7cdd31a3d2bddfc4178e8766c25d1a536b4f337
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri,  6 May 2011 11:38:13 -0300

Added get-real-internal-bounds and get-real-exact-bounds to the ground environment.

Diffstat:
M
src/kgnumbers.c
 | 
34
++++++++++++++++++++++++++++++++++
M
src/kgnumbers.h
 | 
13
+++++++++++--
M
src/kground.c
 | 
5
++++-

3 files changed, 49 insertions(+), 3 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -1113,6 +1113,40 @@ void kreal_to_exact(klisp_State *K, TValue *xparams, TValue ptree,
     kapply_cc(K, res);
 }
 
+/* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */
+void kget_real_internal_bounds(klisp_State *K, TValue *xparams, TValue ptree, 
+			       TValue denv)
+{
+    bind_1tp(K, ptree, "real", krealp, tv_n);
+    /* TEMP: do it here directly, for now all inexact objects have
+     [-inf, +inf] bounds */
+    TValue res;
+    if (ttisexact(tv_n)) {
+	res = klist(K, 2, tv_n, tv_n);
+    } else {
+	res = klist(K, 2, KIMINF, KIPINF);
+    }
+    kapply_cc(K, res);
+}
+
+void kget_real_exact_bounds(klisp_State *K, TValue *xparams, TValue ptree, 
+			       TValue denv)
+{
+    bind_1tp(K, ptree, "real", krealp, tv_n);
+    /* TEMP: do it here directly, for now all inexact objects have
+     [-inf, +inf] bounds, when bounded reals are implemented this
+    should take care to round the min towards -inf and the max towards
+    +inf when converting to exact */
+    TValue res;
+    if (ttisexact(tv_n)) {
+	res = klist(K, 2, tv_n, tv_n);
+    } else {
+	res = klist(K, 2, KEMINF, KEPINF);
+    }
+    kapply_cc(K, res);
+}
+
+
 /* 12.8.1 rational? */
 /* uses ftypep */
 
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -116,10 +116,13 @@ void kgcd(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 12.6.1 exact?, inexact?, robust?, undefined? */
-/* TODO */
+/* use fyped_predp */
 
 /* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */
-/* TODO */
+void kget_real_internal_bounds(klisp_State *K, TValue *xparams, TValue ptree, 
+			       TValue denv);
+void kget_real_exact_bounds(klisp_State *K, TValue *xparams, TValue ptree, 
+			       TValue denv);
 
 /* 12.6.3 get-real-internal-primary, get-real-exact-primary */
 /* TODO */
@@ -160,6 +163,12 @@ void krationalize(klisp_State *K, TValue *xparams, TValue ptree,
 void ksimplest_rational(klisp_State *K, TValue *xparams, TValue ptree, 
 			TValue denv);
 
+
+/* 12.9.1 real? */
+/* uses ftypep */
+
+/* TODO remaining of module real */
+
 /* REFACTOR: These should be in a knumber.h header */
 
 /* Misc Helpers */
diff --git a/src/kground.c b/src/kground.c
@@ -814,7 +814,10 @@ void kinit_ground_env(klisp_State *K)
 		    p2tv(knumberp), p2tv(kundefinedp));
 
     /* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */
-    /* TODO */
+    add_applicative(K, ground_env, "get-real-internal-bounds", 
+		    kget_real_internal_bounds, 0);
+    add_applicative(K, ground_env, "get-real-exact-bounds", 
+		    kget_real_exact_bounds, 0);
 
     /* 12.6.3 get-real-internal-primary, get-real-exact-primary */
     /* TODO */