klisp

commit 31c00b099dd5bd611699d187e150b23879445502
parent c7339828d508e4cbc7fa185f8e163cde24758dd3
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri,  6 May 2011 11:23:20 -0300

Added exact?, inexact?, robust? & undefined? to the ground environment.

Diffstat:
M
src/kgnumbers.c
 | 
5
+++++
M
src/kgnumbers.h
 | 
4
++++
M
src/kground.c
 | 
9
++++++++-
M
src/kobject.h
 | 
8
+++++---

4 files changed, 22 insertions(+), 4 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -43,6 +43,11 @@ bool krealp(TValue obj)
     return ttisrational(obj) || ttiseinf(obj) || ttisiinf(obj); 
 }
 
+bool kexactp(TValue obj) { return ttisexact(obj); }
+bool kinexactp(TValue obj) { return ttisinexact(obj); }
+bool kundefinedp(TValue obj) { return ttisundef(obj); }
+bool krobustp(TValue obj) { return ttisrobust(obj); }
+
  /* 12.5.2 =? */
  /* uses typed_bpredp */
 
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -29,6 +29,10 @@ bool kfinitep(TValue obj);
 bool kintegerp(TValue obj);
 bool krationalp(TValue obj);
 bool krealp(TValue obj);
+bool kexactp(TValue obj);
+bool kinexactp(TValue obj);
+bool kundefinedp(TValue obj);
+bool krobustp(TValue obj);
 
 
 /* 12.5.2 =? */
diff --git a/src/kground.c b/src/kground.c
@@ -804,7 +804,14 @@ void kinit_ground_env(klisp_State *K)
     */
 
     /* 12.6.1 exact?, inexact?, robust?, undefined? */
-    /* TODO */
+    add_applicative(K, ground_env, "exact?", ftyped_predp, 3, symbol, 
+		    p2tv(knumberp), p2tv(kexactp));
+    add_applicative(K, ground_env, "inexact?", ftyped_predp, 3, symbol, 
+		    p2tv(knumberp), p2tv(kinexactp));
+    add_applicative(K, ground_env, "robust?", ftyped_predp, 3, symbol, 
+		    p2tv(knumberp), p2tv(krobustp));
+    add_applicative(K, ground_env, "undefined?", ftyped_predp, 3, symbol, 
+		    p2tv(knumberp), p2tv(kundefinedp));
 
     /* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */
     /* TODO */
diff --git a/src/kobject.h b/src/kobject.h
@@ -165,7 +165,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
 #define K_TDEADKEY        60
 
 /* this is used to test for numbers, as returned by ttype */
-#define K_LAST_NUMBER_TYPE K_TCOMPLEX
+#define K_LAST_NUMBER_TYPE K_TUNDEFINED
 
 /* this is used to if the object is collectable */
 #define K_FIRST_GC_TYPE K_TPAIR
@@ -240,13 +240,15 @@ typedef struct __attribute__ ((__packed__)) GCheader {
 	(ttype(t_) <= K_TBIGRAT) || ttisdouble(t_); })
 #define ttisdouble(o)	((ttag(o) & K_TAG_BASE_MASK) != K_TAG_TAGGED)
 #define ttisreal(o) (ttype(o) < K_TCOMPLEX)
-#define ttisexact(o)					\
+#define ttisexact(o_)					\
     ({ TValue t_ = o_;					\
 	(ttiseinf(t_) || ttype(t_) <= K_TBIGRAT); })
 /* MAYBE this is ugly..., maybe add exact/inexact flag, real, rational flag */
 #define ttisinexact(o_)					\
     ({ TValue t_ = o_;					\
-	(ttisundef(t_) || ttisdouble(t_); || ttiswnpv(t_) || ttisiinf(t_); })
+	(ttisundef(t_) || ttisdouble(t_) || ttisrwnpv(t_) || ttisiinf(t_)); })
+/* For now, all inexact numbers are not robust and have -inf & +inf bounds */
+#define ttisrobust(o)	(ttisexact(o))
 #define ttisnumber(o) (ttype(o) <= K_LAST_NUMBER_TYPE); })
 #define ttiseinf(o)	(tbasetype_(o) == K_TAG_EINF)
 #define ttisiinf(o)	(tbasetype_(o) == K_TAG_IINF)