diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 53e771e4..ace6463e 100644 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -483,6 +483,7 @@ sexp sexp_make_flonum(sexp ctx, double f); #define SEXP_SEVEN sexp_make_fixnum(7) #define SEXP_EIGHT sexp_make_fixnum(8) #define SEXP_NINE sexp_make_fixnum(9) +#define SEXP_TEN sexp_make_fixnum(10) #define sexp_make_character(n) ((sexp) ((((sexp_sint_t)(n))<>SEXP_EXTENDED_BITS)) @@ -510,8 +511,10 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x); #if SEXP_USE_FLONUMS #define sexp_fixnum_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_fixnum(x))) +#define sexp_numberp(x) (sexp_exact_integerp(x) || sexp_flonump(x)) #else #define sexp_fixnum_to_flonum(ctx, x) (x) +#define sexp_numberp(x) sexp_exact_integerp(x) #endif #if SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS @@ -843,6 +846,7 @@ SEXP_API sexp sexp_substring_op (sexp ctx sexp_api_params(self, n), sexp str, se SEXP_API sexp sexp_string_concatenate_op (sexp ctx sexp_api_params(self, n), sexp str_ls, sexp sep); SEXP_API sexp sexp_intern (sexp ctx, const char *str, sexp_sint_t len); SEXP_API sexp sexp_string_to_symbol_op (sexp ctx sexp_api_params(self, n), sexp str); +SEXP_API sexp sexp_string_to_number_op (sexp ctx sexp_api_params(self, n), sexp str, sexp b); SEXP_API sexp sexp_make_vector (sexp ctx, sexp len, sexp dflt); SEXP_API sexp sexp_list_to_vector_op (sexp ctx sexp_api_params(self, n), sexp ls); SEXP_API sexp sexp_make_cpointer (sexp ctx, sexp_uint_t type_id, void* value, sexp parent, int freep); @@ -887,7 +891,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj) #define sexp_register_c_type(ctx, name, finalizer) \ sexp_register_type(ctx, name, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, \ SEXP_ZERO, sexp_make_fixnum(sexp_sizeof(cpointer)), \ - SEXP_ZERO, SEXP_ZERO, finalizer) + SEXP_ZERO, SEXP_ZERO, (sexp_proc2)finalizer) #endif #define sexp_current_error_port(ctx) sexp_env_global_ref(sexp_context_env(ctx),sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL),SEXP_FALSE) @@ -909,6 +913,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj) #define sexp_append2(ctx, a, b) sexp_append2_op(ctx sexp_api_pass(NULL, 2), a, b) #define sexp_list_to_vector(ctx, x) sexp_list_to_vector_op(ctx sexp_api_pass(NULL, 1), x) #define sexp_exception_type(ctx, x) sexp_exception_type_op(ctx sexp_api_pass(NULL, 1), x) +#define sexp_string_to_number(ctx, s, b) sexp_make_string_op(ctx sexp_api_pass(NULL, 2), s, b) #define sexp_make_string(ctx, l, c) sexp_make_string_op(ctx sexp_api_pass(NULL, 2), l, c) #define sexp_string_cmp(ctx, a, b, c) sexp_string_cmp_op(ctx sexp_api_pass(NULL, 3), a, b, c) #define sexp_substring(ctx, a, b, c) sexp_substring_op(ctx sexp_api_pass(NULL, 3), a, b, c) diff --git a/lib/init.scm b/lib/init.scm index b0bea0a7..b7f40fe0 100644 --- a/lib/init.scm +++ b/lib/init.scm @@ -498,24 +498,6 @@ "0" (list->string (if (negative? num) (cons #\- res) res))))))) -(define (string->number str . o) - (let ((res - (cond - ((= 0 (string-length str)) - #f) - ((if (null? o) - #t - (if (eq? 10 (car o)) #t (eq? #\# (string-ref str 0)))) - (call-with-input-string str (lambda (in) (read in)))) - (else - (let ((len (string-length str))) - (let lp ((i 0) (d (car o)) (acc 0)) - (if (>= i len) - acc - (let ((v (digit-value (string-ref str i)))) - (and v (lp (+ i 1) d (+ (* acc d) v))))))))))) - (and (number? res) res))) - ;; vector utils (define (list->vector ls) diff --git a/opcodes.c b/opcodes.c index 86ab0687..4f11e7e0 100644 --- a/opcodes.c +++ b/opcodes.c @@ -101,6 +101,7 @@ _FN4(SEXP_ENV, SEXP_ENV, "%env-copy!", 0, sexp_env_copy_op), _FN2(SEXP_EXCEPTION, SEXP_OPORT, "print-exception", 0, sexp_print_exception_op), _FN1(SEXP_EXCEPTION, "exception-type", 0, sexp_exception_type_op), _FN2OPT(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_character(' '), sexp_make_string_op), +_FN2OPT(SEXP_FIXNUM, SEXP_FIXNUM, "string->number", SEXP_TEN, sexp_string_to_number_op), _FN3(SEXP_STRING, SEXP_STRING, "string-cmp", 0, sexp_string_cmp_op), _FN3(SEXP_STRING, SEXP_FIXNUM, "substring", 0, sexp_substring_op), _FN1(SEXP_STRING, "string->symbol", 0, sexp_string_to_symbol_op), diff --git a/sexp.c b/sexp.c index 1f7c3468..c2981ed4 100644 --- a/sexp.c +++ b/sexp.c @@ -1682,6 +1682,23 @@ sexp sexp_read_from_string (sexp ctx, const char *str, sexp_sint_t len) { return res; } +sexp sexp_string_to_number_op (sexp ctx sexp_api_params(self, n), sexp str, sexp b) { + int base; + sexp_gc_var1(in); + if (! sexp_stringp(str)) + return sexp_type_exception(ctx, "string->number: not a string", str); + else if (! sexp_numberp(b)) + return sexp_type_exception(ctx, "string->number: not a number", b); + if (((base=sexp_unbox_fixnum(b)) < 2) || (base > 36)) + return sexp_type_exception(ctx, "string->number: bad base", b); + sexp_gc_preserve1(ctx, in); + in = sexp_make_input_string_port(ctx, str); + in = ((sexp_string_data(str)[0] == '#') ? + sexp_read(ctx, in) : sexp_read_number(ctx, in, base)); + sexp_gc_release1(ctx); + return sexp_numberp(in) ? in : SEXP_FALSE; +} + sexp sexp_write_to_string (sexp ctx, sexp obj) { sexp str; sexp_gc_var1(out);