Added optional arg to string->number

include/cyclone/runtime.h

@@ -154,6 +154,7 @@ object Cyc_symbol2string(void *d, object cont, object sym) ;
 object Cyc_string2symbol(void *d, object str);
 object Cyc_list2string(void *d, object cont, object lst);
 common_type Cyc_string2number(void *d, object str);
+common_type Cyc_string2number2(void *data, int argc, object str, ...);
 int binstr2int(const char *str);
 int octstr2int(const char *str);
 int hexstr2int(const char *str);

runtime.c

@@ -1028,6 +1028,36 @@ object Cyc_list2string(void *data, object cont, object lst){
       return_closcall1(data, cont, &str);}
 }
 
+common_type Cyc_string2number2(void *data, int argc, object str, ...) 
+{
+  object base = nil;
+  common_type result;
+  va_list ap;
+  va_start(ap, str);
+  if (argc > 1) {
+    base = va_arg(ap, object);
+    Cyc_check_int(data, base);
+  }
+  va_end(ap);
+  if (base) {
+    Cyc_check_str(data, str);
+    result.integer_t.hdr.mark = gc_color_red;
+    result.integer_t.hdr.grayed = 0;
+    result.integer_t.tag = integer_tag;
+    if (integer_value(base) == 2) {
+      result.integer_t.value = binstr2int(string_str(str));
+      return result;
+    }else if (integer_value(base) == 8) {
+      result.integer_t.value = octstr2int(string_str(str));
+      return result;
+    }else if (integer_value(base) == 16) {
+      result.integer_t.value = hexstr2int(string_str(str));
+      return result;
+    }
+  }
+  return Cyc_string2number(data, str);
+}
+
 common_type Cyc_string2number(void *data, object str){
     common_type result;
     double n;
@@ -1900,8 +1930,13 @@ void _integer_91_125char(void *data, object cont, object args) {
     return_closcall1(data, cont, Cyc_integer2char(data, car(args)));}
 void _string_91_125number(void *data, object cont, object args) {  
     Cyc_check_num_args(data, "string->number", 1, args);
-    { common_type i = Cyc_string2number(data, car(args));
+    { object tail = cdr(args);
-      return_closcall1(data, cont, &i);}}
+      if (tail) {
+        common_type i = Cyc_string2number2(data, 2, car(args), cadr(args));
+        return_closcall1(data, cont, &i);
+      } else {
+        common_type i = Cyc_string2number(data, car(args));
+        return_closcall1(data, cont, &i);}}}
 void _string_91length(void *data, object cont, object args) {
     Cyc_check_num_args(data, "string-length", 1, args);
     { integer_type i = Cyc_string_length(data, car(args));

scheme/cyclone/cgen.sld

@@ -519,7 +519,7 @@
      ((eq? p 'cddddr)        "cddddr")
      ((eq? p 'char->integer) "Cyc_char2integer")
      ((eq? p 'integer->char) "Cyc_integer2char")
-     ((eq? p 'string->number)"Cyc_string2number")
+     ((eq? p 'string->number)"Cyc_string2number2")
      ((eq? p 'list->string)  "Cyc_list2string")
      ((eq? p 'make-vector)   "Cyc_make_vector")
      ((eq? p 'list->vector)  "Cyc_list2vector")
@@ -705,7 +705,9 @@
 ;; Pass an integer arg count as the function's first parameter?
 (define (prim:arg-count? exp)
     (and (prim? exp)
-         (member exp '(error Cyc-write Cyc-display string-append + - * /))))
+         (member exp '(error Cyc-write Cyc-display 
+                       string->number string-append 
+                       + - * /))))
 
 ;; Does primitive allocate an object?
 ;; TODO: these are the functions that are defined via macros. This method