klisp

commit 641b5ac451f08a28afaf736b5db525b8b538c733
parent 35450d1397acb1f43613a131df43111ef214eb16
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat, 30 Apr 2011 14:44:26 -0300

Added exponent support in decimal format (I forgot about this when implementing rationals). Added out var to krational_read_decimal to detect if there was a decimal point (in preparation for inexact numbers).

Diffstat:
M
src/krational.c
 | 
88
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----------
M
src/krational.h
 | 
2
+-
M
src/ktoken.c
 | 
2
+-

3 files changed, 78 insertions(+), 14 deletions(-)
diff --git a/src/krational.c b/src/krational.c
@@ -8,6 +8,7 @@
 #include <stdint.h>
 #include <string.h> /* for code checking '/' & '.' */
 #include <inttypes.h>
+#include <ctype.h> /* for to lower */
 #include <math.h>
 
 #include "krational.h"
@@ -85,39 +86,102 @@ bool krational_read(klisp_State *K, char *buf, int32_t base, TValue *out,
 
 /* NOTE: allow decimal for use after #e */
 bool krational_read_decimal(klisp_State *K, char *buf, int32_t base, TValue *out, 
-			    char **end)
+			    char **end, bool *out_decimalp)
 {
+    /* NOTE: in Kernel only base ten is allowed in decimal format */
+    klisp_assert(base == 10);
+
     char *my_end;
     if (!end) /* always get the last char not read */
 	end = &my_end;
 
     TValue res = kbigrat_make_simple(K);
     krooted_tvs_push(K, res);
-    bool ret_val = (mp_rat_read_ustring(K, tv2bigrat(res), base, 
-					buf, end) == MP_OK);
-    krooted_tvs_pop(K);
-    *out = kbigrat_try_integer(K, res);
+    mp_result ret_val = mp_rat_read_ustring(K, tv2bigrat(res), base, 
+					buf, end);
+
+    /* check to see if there was a decimal point, will only
+     be written to out_decimalp if no error ocurr */
+    bool decimalp = memchr(buf, '.', *end - buf) != NULL;
+
+    /* handle exponents, avoid the case where the number finishes
+     in a decimal point (this isn't allowed by kernel */
+    if (decimalp && ret_val == MP_TRUNC && *end != buf &&
+	  *((*end)-1) != '.') {
+	char *ebuf = *end;
+	char el = tolower(*ebuf);
+	/* NOTE: in klisp all exponent letters map to double */
+	if (el == 'e' || el == 's' || el == 'f' || el == 'd' || el == 'l') {
+	    ebuf++;
+	    TValue tv_exp_exp = kbigint_make_simple(K);
+	    krooted_tvs_push(K, tv_exp_exp);
+	    Bigint *exp_exp = tv2bigint(tv_exp_exp);
+	    /* base should be 10 */
+	    ret_val = mp_int_read_cstring(K, exp_exp, base, ebuf, end);
+	    if (ret_val == MP_OK) {
+		/* IMath doesn't have general rational exponentiation,
+		   so do it manually */
+		TValue tv_iexp = kbigint_make_simple(K);
+		krooted_tvs_push(K, tv_iexp);
+		Bigint *iexp = tv2bigint(tv_iexp);
+		UNUSED(mp_int_set_value(K, iexp, 10));
+		bool negativep = mp_int_compare_zero(exp_exp) < 0;
+		UNUSED(mp_int_abs(K, exp_exp, exp_exp));
+		UNUSED(mp_int_expt_full(K, iexp, exp_exp, iexp));
+		/* iexp has 10^|exp_exp| */
+		if (negativep) {
+		    TValue tv_rexp = kbigrat_make_simple(K);
+		    krooted_tvs_push(K, tv_rexp);
+		    Bigrat *rexp = tv2bigrat(tv_rexp);
+		    /* copy reciprocal of iexp to rexp */
+		    UNUSED(mp_rat_zero(K, rexp));
+		    UNUSED(mp_rat_add_int(K, rexp, iexp, rexp));
+		    UNUSED(mp_rat_recip(K, rexp, rexp));
+		    /* now get true number */
+		    UNUSED(mp_rat_mul(K, tv2bigrat(res), rexp,
+				      tv2bigrat(res)));
+		    krooted_tvs_pop(K); /* rexp */
+		} else { /* exponent positive, can just mult int */
+		    UNUSED(mp_rat_mul_int(K, tv2bigrat(res), iexp,
+					  tv2bigrat(res)));
+		}
+		krooted_tvs_pop(K); /* iexp */
+		/* fall through, ret_val remains MP_OK */
+	    } /* else, fall through, ret_val remains != MP_OK */
+	    krooted_tvs_pop(K); /* exp_exp */
+	}
+    }
 
     /* TODO: ideally this should be incorporated in the read code */
+    /* TODO: if returning MP_TRUNC adjust the end pointer returned */
     /* detect sign after '/', or trailing '.' or starting '/' or '.'. 
        Those are allowed by imrat but not by kernel */
-    if (ret_val) {
+    if (ret_val == MP_OK) {
 	char *ch = strchr(buf, '/');
 	if (ch != NULL && (ch == 0 || 
 			   (*(ch+1) == '+' || *(ch+1) == '-') ||
-			   (*(ch-1) == '+' || *(ch-1) == '-')))
-	    ret_val = false;
-	else {
+			   (*(ch-1) == '+' || *(ch-1) == '-'))) {
+	    ret_val = MP_TRUNC;
+	} else {
 	    ch = strchr(buf, '.');
 	    if (ch != NULL && (ch == 0 || 
 			       (*(ch+1) == '+' || *(ch+1) == '-') ||
 			       (*(ch-1) == '+' || *(ch-1) == '-') ||
-			       ch == *end - 1))
-		ret_val = false;
+			       ch == *end - 1)) {
+		ret_val = MP_TRUNC;
+	    }
 	}
     }
 
-    return ret_val;
+    if (ret_val == MP_OK && out_decimalp != NULL)
+	*out_decimalp = decimalp;
+
+    krooted_tvs_pop(K);
+    if (ret_val == MP_OK) {
+	*out = kbigrat_try_integer(K, res);
+    }
+
+    return ret_val == MP_OK;
 }
 
 /* this is used by write to estimate the number of chars necessary to
diff --git a/src/krational.h b/src/krational.h
@@ -132,7 +132,7 @@ bool krational_read(klisp_State *K, char *buf, int32_t base, TValue *out,
 		   char **end);
 /* NOTE: allow decimal for use after #e */
 bool krational_read_decimal(klisp_State *K, char *buf, int32_t base, TValue *out, 
-			    char **end);
+			    char **end, bool *out_decimalp);
 
 int32_t kbigrat_print_size(TValue tv_bigrat, int32_t base);
 void  kbigrat_print_string(klisp_State *K, TValue tv_bigrat, int32_t base, 
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -402,7 +402,7 @@ TValue ktok_read_number(klisp_State *K, char *buf, int32_t len,
     if (has_exactp && radix == 10) {
 	/* TEMP: while there are no inexacts */
 	/* allow decimals if has #e prefix */
-	if (!krational_read_decimal(K, buf, radix, &n, NULL)) {
+	if (!krational_read_decimal(K, buf, radix, &n, NULL, NULL)) {
 	    /* TODO throw meaningful error msgs, use last param */
 	    ktok_error(K, "Bad format in number");
 	    return KINERT;