klisp

commit 3eb33dadbbb851936590ce7a9d7f2a51ba6b62bd
parent 986e75653f1c68b688dbc604a9c1a2fd40e20872
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat, 30 Apr 2011 23:22:41 -0300

First exact_to_inexact approx.

Diffstat:
M
src/kreal.c
 | 
45
+++++++++++++++++++++++++++++++++++++++------

1 file changed, 39 insertions(+), 6 deletions(-)
diff --git a/src/kreal.c b/src/kreal.c
@@ -19,16 +19,49 @@
 #include "kmem.h"
 #include "kgc.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;
+    uint32_t ndigits = bigint->used - 1;
+    double accum = 0;
+	
+    /* bigint is in little endian format, but we traverse in
+     big endian */
+    while(ndigits >= 0) {
+	accum = accum * radix + (double) bigint->digits[ndigits];
+	--ndigits;
+    }
+}
+
 TValue kexact_to_inexact(klisp_State *K, TValue n)
 {
     switch(ttype(n)) {
     case K_TFIXINT:
-    case K_TBIGINT:
-    case K_TBIGRAT:
-    case K_TEINF:
-	/* TODO */
+	return d2tv((double) ivalue(n));
+    case K_TBIGINT: {
+	double d = kbigint_to_double(tv2bigint(n));
+	/* d may be inf, ktag_double will handle it */
+	/* MAYBE should throw an exception if strict is on */
+	return ktag_double(d);
+    }
+    case K_TBIGRAT: {
 	klisp_assert(0);
-	/* all of these are already inexact */
+	return KUNDEF;
+    }
+    case K_TEINF:
+	return tv_equal(n, KEPINF)? KIPINF : KIMINF;
+    /* all of these are already inexact */
     case K_TDOUBLE:
     case K_TIINF:
     case K_TRWNPV:
@@ -36,6 +69,6 @@ TValue kexact_to_inexact(klisp_State *K, TValue n)
 	return n;
     default:
 	klisp_assert(0);
-	return KINERT;
+	return KUNDEF;
     }
 }