commit bc4220d6b34b418e39d4470c650b7567345c6533
parent 414fbf46674713ceaf1ca79b8cd3367b1ebf41f2
Author: Andres Navarro <canavarro82@gmail.com>
Date: Fri, 2 Dec 2011 03:01:29 -0300
Added number->string to the ground environment.
Diffstat:
8 files changed, 178 insertions(+), 6 deletions(-)
diff --git a/TODO b/TODO
@@ -22,7 +22,6 @@
** update the manual with the current features
** add a section to the manual with the interpreter usage
* applicatives:
-** number->string (r7rs)
** string->number (r7rs)
* reader/writer
** syntax support for complex numbers (Kernel report)
diff --git a/src/imath.c b/src/imath.c
@@ -1866,7 +1866,7 @@ mp_result mp_int_to_string(klisp_State *K, mp_int z, mp_size radix,
return MP_RANGE;
if(CMPZ(z) == 0) {
- *str++ = s_val2ch(0, 1);
+ *str++ = s_val2ch(0, 0); /* changed to lowercase, Andres Navarro */
}
else {
mpz_t tmp;
@@ -1889,7 +1889,7 @@ mp_result mp_int_to_string(klisp_State *K, mp_int z, mp_size radix,
break;
d = s_ddiv(&tmp, (mp_digit)radix);
- *str++ = s_val2ch(d, 1);
+ *str++ = s_val2ch(d, 0); /* changed to lowercase, Andres Navarro */
}
t = str - 1;
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -14,6 +14,7 @@
#include <stdlib.h>
#include <stdbool.h>
#include <stdint.h>
+#include <inttypes.h> /* for string conversion */
#include "kstate.h"
#include "kobject.h"
@@ -2268,6 +2269,120 @@ void kexpt(klisp_State *K)
arith_kapply_cc(K, res);
}
+/* Number<->String conversion */
+void number_to_string(klisp_State *K)
+{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(denv);
+ UNUSED(xparams);
+
+ bind_al1tp(K, ptree, "number", knumberp, obj, maybe_radix);
+ int radix = 10;
+ if (get_opt_tpar(K, maybe_radix, "radix (2, 8, 10, or 16)", ttisradix))
+ radix = ivalue(maybe_radix);
+
+ char small_buf[64]; /* for fixints */
+ TValue buf_str = K->empty_string; /* for bigrats, bigints and doubles */
+ krooted_vars_push(K, &buf_str);
+ char *buf;
+
+ switch(ttype(obj)) {
+ case K_TFIXINT: {
+ /* can't use snprintf here... there's no support for binary,
+ so just do by hand */
+ uint32_t value;
+ /* convert to unsigned to write */
+ value = (uint32_t) ((ivalue(obj) < 0)?
+ -((int64_t) ivalue(obj)) :
+ ivalue(obj));
+ char *digits = "0123456789abcdef";
+ /* write backwards so we don't have to reverse the buffer */
+ buf = small_buf + sizeof(small_buf) - 1;
+ *buf-- = '\0';
+ do {
+ *buf-- = digits[value % radix];
+ value /= radix;
+ } while(value > 0); /* with the guard down it works for zero too */
+
+ /* only put the sign if negative,
+ then correct the pointer to the first char */
+ if (ivalue(obj) < 0)
+ *buf = '-';
+ else
+ ++buf;
+ break;
+ }
+ case K_TBIGINT: {
+ int32_t size = kbigint_print_size(obj, radix);
+ /* here we are using 1 byte extra, because size already includes
+ 1 for the terminator, but better be safe than sorry */
+ buf_str = kstring_new_s(K, size);
+ buf = kstring_buf(buf_str);
+ kbigint_print_string(K, obj, radix, buf, size);
+ /* the string will be copied and trimmed later,
+ because print_size may overestimate */
+ break;
+ }
+ case K_TBIGRAT: {
+ int32_t size = kbigrat_print_size(obj, radix);
+ /* here we are using 1 byte extra, because size already includes
+ 1 for the terminator, but better be safe than sorry */
+ buf_str = kstring_new_s(K, size);
+ buf = kstring_buf(buf_str);
+ kbigrat_print_string(K, obj, radix, buf, size);
+ /* the string will be copied and trimmed later,
+ because print_size may overestimate */
+ break;
+ }
+ case K_TEINF:
+ buf = tv_equal(obj, KEPINF)? "#e+infinity" : "#e-infinity";
+ break;
+ case K_TIINF:
+ buf = tv_equal(obj, KIPINF)? "#i+infinity" : "#i-infinity";
+ break;
+ case K_TDOUBLE: {
+ if (radix != 10) {
+ /* only radix 10 is supported for inexact numbers
+ see rationale in the report (technically they could be
+ printed without a decimal point, like fractions, but...*/
+ klispE_throw_simple_with_irritants(K, "radix != 10 with inexact "
+ "number", 2, obj,maybe_radix);
+ return;
+ }
+ /* radix is always 10 */
+ int32_t size = kdouble_print_size(obj);
+ /* here we are using 1 byte extra, because size already includes
+ 1 for the terminator, but better be safe than sorry */
+ buf_str = kstring_new_s(K, size);
+ buf = kstring_buf(buf_str);
+ kdouble_print_string(K, obj, buf, size);
+ /* the string will be copied and trimmed later,
+ because print_size may overestimate */
+ break;
+ }
+ case K_TRWNPV:
+ buf = "#real";
+ break;
+ case K_TUNDEFINED:
+ buf = "#undefined";
+ break;
+ default:
+ /* shouldn't happen */
+ klisp_assert(0);
+ }
+
+ TValue str = kstring_new_b(K, buf);
+ krooted_vars_pop(K);
+ kapply_cc(K, str);
+}
+
+/* TODO */
+void string_to_number(klisp_State *K)
+{
+}
/* init ground */
void kinit_numbers_ground_env(klisp_State *K)
@@ -2407,5 +2522,7 @@ void kinit_numbers_ground_env(klisp_State *K)
/* 12.9.6 expt */
add_applicative(K, ground_env, "expt", kexpt, 0);
- /* TODO add some conversion like number->string, string->number */
+ /* 12.? string->number, number->string */
+ add_applicative(K, ground_env, "string->number", string_to_number, 0);
+ add_applicative(K, ground_env, "number->string", number_to_string, 0);
}
diff --git a/src/kinteger.c b/src/kinteger.c
@@ -68,6 +68,7 @@ bool kinteger_read(klisp_State *K, char *buf, int32_t base, TValue *out,
print the number */
int32_t kbigint_print_size(TValue tv_bigint, int32_t base)
{
+ klisp_assert(ttisbigint(tv_bigint));
return mp_int_string_len(tv2bigint(tv_bigint), base);
}
@@ -75,6 +76,7 @@ int32_t kbigint_print_size(TValue tv_bigint, int32_t base)
void kbigint_print_string(klisp_State *K, TValue tv_bigint, int32_t base,
char *buf, int32_t limit)
{
+ klisp_assert(ttisbigint(tv_bigint));
mp_result res = mp_int_to_string(K, tv2bigint(tv_bigint), base, buf,
limit);
/* only possible error is truncation */
diff --git a/src/kobject.h b/src/kobject.h
@@ -248,6 +248,12 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define ttisu8(o) ({ \
TValue o__ = (o); \
(ttisfixint(o__) && ivalue(o__) >= 0 && ivalue(o__) < 256); })
+/* for radixes in string<->number */
+#define ttisradix(o) ({ \
+ TValue o__ = (o); \
+ (ttisfixint(o__) && \
+ (ivalue(o__) == 2 || ivalue(o__) == 8 || \
+ ivalue(o__) == 10 || ivalue(o__) == 16)); })
/* for bases in char->digit and related functions */
#define ttisbase(o) ({ \
TValue o__ = (o); \
diff --git a/src/krational.c b/src/krational.c
@@ -190,15 +190,17 @@ bool krational_read_decimal(klisp_State *K, char *buf, int32_t base, TValue *out
/* this is used by write to estimate the number of chars necessary to
print the number */
-int32_t kbigrat_print_size(TValue tv_bigint, int32_t base)
+int32_t kbigrat_print_size(TValue tv_bigrat, int32_t base)
{
- return mp_rat_string_len(tv2bigrat(tv_bigint), base);
+ klisp_assert(ttisbigrat(tv_bigrat));
+ return mp_rat_string_len(tv2bigrat(tv_bigrat), base);
}
/* this is used by write */
void kbigrat_print_string(klisp_State *K, TValue tv_bigrat, int32_t base,
char *buf, int32_t limit)
{
+ klisp_assert(ttisbigrat(tv_bigrat));
mp_result res = mp_rat_to_string(K, tv2bigrat(tv_bigrat), base, buf,
limit);
/* only possible error is truncation */
diff --git a/src/kreal.c b/src/kreal.c
@@ -562,6 +562,7 @@ bool dtoa(klisp_State *K, double d, char *buf, int32_t upoint, int32_t *out_h,
number */
int32_t kdouble_print_size(TValue tv_double)
{
+ klisp_assert(ttisdouble(tv_double));
UNUSED(tv_double);
return 1024;
}
@@ -569,6 +570,7 @@ int32_t kdouble_print_size(TValue tv_double)
void kdouble_print_string(klisp_State *K, TValue tv_double,
char *buf, int32_t limit)
{
+ klisp_assert(ttisdouble(tv_double));
/* TODO: add exponent to values too large or too small */
/* TEMP */
int32_t h = 0;
diff --git a/src/tests/numbers.k b/src/tests/numbers.k
@@ -423,3 +423,46 @@
;; 12.10 Complex features
;; not implemented
+
+;; String conversion
+($check string-ci=? (number->string 0) "0")
+($check string-ci=? (number->string 1) "1")
+($check string-ci=? (number->string -1) "-1")
+($check string-ci=? (number->string 2 2) "10")
+($check string-ci=? (number->string -2 2) "-10")
+($check string-ci=? (number->string 8 8) "10")
+($check string-ci=? (number->string -8 8) "-10")
+($check string-ci=? (number->string 10 10) "10")
+($check string-ci=? (number->string -10 10) "-10")
+($check string-ci=? (number->string 16 16) "10")
+($check string-ci=? (number->string -16 16) "-10")
+; default base
+($check string-ci=? (number->string 10) (number->string 10 10))
+;; infinities, undefined and reals with no primary value
+($check string-ci=? (number->string #undefined) "#undefined")
+($check string-ci=? (number->string #real) "#real")
+($check string-ci=? (number->string #e+infinity) "#e+infinity")
+($check string-ci=? (number->string #e-infinity) "#e-infinity")
+($check string-ci=? (number->string #i+infinity) "#i+infinity")
+($check string-ci=? (number->string #i-infinity) "#i-infinity")
+;; rationals
+($check string-ci=? (number->string 13/17) "13/17")
+($check string-ci=? (number->string -17/13) "-17/13")
+($check string-ci=? (number->string #o-21/15 8) "-21/15")
+;; bigints
+($check string-ci=? (number->string #x1234567890abcdef 16)
+ "1234567890abcdef")
+
+; only bases 2, 8, 10, 16
+($check-error (number->string 10 3))
+($check-error (number->string #inert ()))
+; only numbers
+($check-error (number->string #inert))
+($check-error (number->string #inert 2))
+; only numbers
+($check-error (number->string "2"))
+($check-error (number->string "2" 8))
+; only base 10 with inexact numbers
+($check-error (number->string -1.0 2))
+($check-error (number->string 1.25 8))
+($check-error (number->string 3.0 16))
+\ No newline at end of file
