klisp

commit 6c7371e743a67c2bfe1a3bfb1ba2b944857c806c
parent 21c9adcd718703fbb6a12c6798d21910ba316ca2
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed,  4 May 2011 21:13:06 -0300

Added real->inexact & real->exact to the ground environment.

Diffstat:
M
src/kgnumbers.c
 | 
30
+++++++++++++++++++++++++++++-
M
src/kgnumbers.h
 | 
24
++++++++++++++++++++++++
M
src/kground.c
 | 
35
+++++++++++++++++++++++++++++++++++

3 files changed, 88 insertions(+), 1 deletion(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -19,6 +19,7 @@
 #include "ksymbol.h"
 #include "kinteger.h"
 #include "krational.h"
+#include "kreal.h"
 
 #include "kghelpers.h"
 #include "kgnumbers.h"
@@ -1081,7 +1082,34 @@ void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 
-/* TODO: remaining of rational module */
+/* TODO remainding of module real and inexact */
+
+/* 12.6.5 real->inexact, real->exact */
+void kreal_to_inexact(klisp_State *K, TValue *xparams, TValue ptree, 
+		      TValue denv)
+{
+    UNUSED(denv);
+    UNUSED(xparams);
+
+    bind_1tp(K, ptree, "real", krealp, tv_n);
+
+    TValue res = kexact_to_inexact(K, tv_n);
+    kapply_cc(K, res);
+}
+/* ASK John, the error signaling depends on with-strict-arithmetic, or
+   not? Should always throw error on overflow and underflow? and when 
+   the precission isn't that great? */
+void kreal_to_exact(klisp_State *K, TValue *xparams, TValue ptree, 
+		      TValue denv)
+{
+    UNUSED(denv);
+    UNUSED(xparams);
+
+    bind_1tp(K, ptree, "real", krealp, tv_n);
+
+    TValue res = kinexact_to_exact(K, tv_n);
+    kapply_cc(K, res);
+}
 
 /* 12.8.1 rational? */
 /* uses ftypep */
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -111,6 +111,30 @@ void kmin_max(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 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 */
+
+/* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */
+/* TODO */
+
+/* 12.6.3 get-real-internal-primary, get-real-exact-primary */
+/* TODO */
+
+/* 12.6.4 make-inexact */
+/* TODO */
+
+/* 12.6.5 real->inexact, real->exact */
+void kreal_to_inexact(klisp_State *K, TValue *xparams, TValue ptree, 
+		      TValue denv);
+/* ASK John, the error signaling depends on with-strict-arithmetic, or
+   not? Should always throw error on overflow and underflow? and when 
+   the precission isn't that great? */
+void kreal_to_exact(klisp_State *K, TValue *xparams, TValue ptree, 
+		      TValue denv);
+
+/* 12.6.6 with-strict-arithmetic, get-strict-arithmetic? */
+/* TODO */
+
 /* 12.8.1 rational? */
 /* uses ftypep */
 
diff --git a/src/kground.c b/src/kground.c
@@ -800,6 +800,32 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "lcm", klcm, 0);
 
     /* 
+    ** 12.8 Inexact features
+    */
+
+    /* 12.6.1 exact?, inexact?, robust?, undefined? */
+    /* TODO */
+
+    /* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */
+    /* TODO */
+
+    /* 12.6.3 get-real-internal-primary, get-real-exact-primary */
+    /* TODO */
+
+    /* 12.6.4 make-inexact */
+    /* TODO */
+
+    /* 12.6.5 real->inexact, real->exact */
+    /* ASK John, the error signaling depends on with-strict-arithmetic, or
+       not? Should always throw error on overflow and underflow? and when 
+       the precission isn't that great? */
+    add_applicative(K, ground_env, "real->inexact", kreal_to_inexact, 0);
+    add_applicative(K, ground_env, "real->exact", kreal_to_exact, 0);
+
+    /* 12.6.6 with-strict-arithmetic, get-strict-arithmetic? */
+    /* TODO */
+
+    /* 
     ** 12.8 Rational features
     */
 
@@ -828,6 +854,15 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "rationalize", krationalize, 0);
     add_applicative(K, ground_env, "simplest-rational", ksimplest_rational, 0);
 
+    /* 
+    ** 12.9 Real features
+    */
+
+    /* 12.9.1 real? */
+    /* TODO */
+
+    /* TODO complete all other bindings of module real */
+
     /*
     **
     ** 13 Strings