rewriting string->number in C to fix the error catching problem (should return #f)

this calls sexp_read_number directly passing the base, so the
C implementation is shorter than the Scheme implementation,
much faster, and as an opcode generates smaller bytecode per use.

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) + SEXP_CHAR_TAG))
 #define sexp_unbox_character(n) ((int) (((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)

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)

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),

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);