klisp

commit c7339828d508e4cbc7fa185f8e163cde24758dd3
parent 6c7371e743a67c2bfe1a3bfb1ba2b944857c806c
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri,  6 May 2011 11:01:17 -0300

Rearranged the tags in kobject so that einf > double. Moved tag_double to from kreal to kobject for use from other files.

Diffstat:
M
src/kobject.h
 | 
24
++++++++++++++++++++----
M
src/kreal.c
 | 
10
+---------

2 files changed, 21 insertions(+), 13 deletions(-)
diff --git a/src/kobject.h b/src/kobject.h
@@ -130,9 +130,9 @@ typedef struct __attribute__ ((__packed__)) GCheader {
 #define K_TBIGINT       1
 #define K_TFIXRAT       2
 #define K_TBIGRAT       3
-#define K_TEINF         4
-#define K_TDOUBLE       5
-#define K_TBDOUBLE      6
+#define K_TDOUBLE       4
+#define K_TBDOUBLE      5
+#define K_TEINF         6
 #define K_TIINF         7
 #define K_TRWNPV        8
 #define K_TCOMPLEX      9
@@ -177,7 +177,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
 **
 ** - decide if inexact infinities and reals with no
 **    primary values are included in K_TDOUBLE
-** - For now we will only use fixints, bigints, bigrats and exact infinities 
+** - All types except complexs, bounded reals and fixrats 
 */
 #define K_TAG_FIXINT	K_MAKE_VTAG(K_TFIXINT)
 #define K_TAG_BIGINT	K_MAKE_VTAG(K_TBIGINT)
@@ -240,6 +240,13 @@ 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)					\
+    ({ 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_); })
 #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)
@@ -580,6 +587,15 @@ const TValue kfree;
 #define b2tv_(b_) {.tv = {.t = K_TAG_BOOLEAN, .v = { .b = (b_) }}}
 #define p2tv_(p_) {.tv = {.t = K_TAG_USER, .v = { .p = (p_) }}}
 #define d2tv_(d_) {.d = d_}
+#define ktag_double(d_)							\
+    ({ double d__ = d_;							\
+	TValue res;							\
+	if (isnan(d__)) res = KRWNPV;					\
+	else if (isinf(d__)) res = (d__ == INFINITY)? KIPINF : KIMINF;	\
+	/* +0.0 == -0.0 too, but that doesn't hurt */			\
+	else if (d_ == -0.0) res = d2tv(+0.0);				\
+	else res = d2tv(d__);						\
+	res;})
 
 /* Macros to create TValues of non-heap allocated types */
 #define ch2tv(ch_) ((TValue) ch2tv_(ch_))
diff --git a/src/kreal.c b/src/kreal.c
@@ -21,15 +21,6 @@
 #include "kpair.h" /* for list in throw error */
 #include "kerror.h"
 
-/* MAYBE move to kobject.h */
-#define ktag_double(d_)							\
-    ({ double d__ = d_;							\
-	TValue res;							\
-	if (isnan(d__)) res = KRWNPV;					\
-	else if (isinf(d__)) res = (d__ == INFINITY)? KIPINF : KIMINF;	\
-	else res = d2tv(d__);						\
-	res;})
-
 double kbigint_to_double(Bigint *bigint)
 {
     double radix = (double) UINT32_MAX + 1.0;
@@ -389,6 +380,7 @@ bool dtoa(klisp_State *K, double d, char *buf, int32_t upoint, int32_t *out_h,
     res = mp_int_add_value(K, &f, (mp_small) im & 0x7fffffff, &f);
 
     /* adjust f & p so that p is 53 TODO do in one step */
+    /* XXX: this is not ok for denorms!! */
     while(ip < 53) {
 	++ip;
 	res = mp_int_mul_value(K, &f, 2, &f);