diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index f1b19093..e8a6d588 100644 --- a/include/cyclone/runtime.h +++ b/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); diff --git a/runtime.c b/runtime.c index 5cb9b664..d2a3bc02 100644 --- a/runtime.c +++ b/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)); - return_closcall1(data, cont, &i);}} + { object tail = cdr(args); + 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)); diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index e9243b52..6955b712 100644 --- a/scheme/cyclone/cgen.sld +++ b/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