diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 47ccf12b..9d83a4fd 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -339,6 +339,7 @@ extern const object primitive_cddddr; extern const object primitive_char_91_125integer; extern const object primitive_integer_91_125char; extern const object primitive_string_91_125number; +extern const object primitive_string_91_125number2; extern const object primitive_string_91cmp; extern const object primitive_string_91append; extern const object primitive_list_91_125string; diff --git a/runtime.c b/runtime.c index 73147a8a..781abf0b 100644 --- a/runtime.c +++ b/runtime.c @@ -2040,6 +2040,13 @@ void _string_91_125number(void *data, object cont, object args) { } else { common_type i = Cyc_string2number(data, car(args)); return_closcall1(data, cont, &i);}}} +void _string_91_125number2(void *data, object cont, object args) { + Cyc_check_num_args(data, "string->number2", 1, args); + { object tail = cdr(args); + if (tail) { + Cyc_string2number2_(data, cont, 2, car(args), cadr(args)); + } else { + Cyc_string2number_(data, cont, car(args)); }}} 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)); @@ -2711,6 +2718,7 @@ static primitive_type cddddr_primitive = {{0}, primitive_tag, "cddddr", &_cddddr static primitive_type char_91_125integer_primitive = {{0}, primitive_tag, "char->integer", &_char_91_125integer}; static primitive_type integer_91_125char_primitive = {{0}, primitive_tag, "integer->char", &_integer_91_125char}; static primitive_type string_91_125number_primitive = {{0}, primitive_tag, "string->number", &_string_91_125number}; +static primitive_type string_91_125number_primitive2 = {{0}, primitive_tag, "string->number2", &_string_91_125number2}; static primitive_type string_91length_primitive = {{0}, primitive_tag, "string-length", &_string_91length}; static primitive_type substring_primitive = {{0}, primitive_tag, "substring", &_cyc_substring}; static primitive_type string_91ref_primitive = {{0}, primitive_tag, "string-ref", &_cyc_string_91ref}; @@ -2832,6 +2840,7 @@ const object primitive_cddddr = &cddddr_primitive; const object primitive_char_91_125integer = &char_91_125integer_primitive; const object primitive_integer_91_125char = &integer_91_125char_primitive; const object primitive_string_91_125number = &string_91_125number_primitive; +const object primitive_string_91_125number2 = &string_91_125number_primitive2; const object primitive_string_91length = &string_91length_primitive; const object primitive_substring = &substring_primitive; const object primitive_string_91ref = &string_91ref_primitive; diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 002808a0..7a8ea8e5 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -521,6 +521,7 @@ ((eq? p 'char->integer) "Cyc_char2integer") ((eq? p 'integer->char) "Cyc_integer2char") ((eq? p 'string->number)"Cyc_string2number2") + ((eq? p 'string->number2)"Cyc_string2number2_") ((eq? p 'list->string) "Cyc_list2string") ((eq? p 'make-vector) "Cyc_make_vector") ((eq? p 'list->vector) "Cyc_list2vector") @@ -603,6 +604,7 @@ Cyc-write-char integer->char string->number + string->number2 list->string make-vector list->vector @@ -650,6 +652,7 @@ ((eq? p '*) "common_type") ((eq? p '/) "common_type") ((eq? p 'string->number) "common_type") + ((eq? p 'string->number2) "object") ((eq? p 'string-cmp) "integer_type") ((eq? p 'string-append) "object") ((eq? p 'string-length) "integer_type") @@ -680,6 +683,7 @@ system Cyc-installation-dir string->number + string->number2 string-append string-cmp list->string make-vector list->vector symbol->string number->string @@ -695,7 +699,7 @@ (and (prim? exp) (member exp '(Cyc-read-line apply command-line-arguments number->string read-char peek-char - symbol->string list->string substring string-append + symbol->string list->string substring string-append string->number2 make-vector list->vector Cyc-installation-dir)))) ;; Primitive functions that pass a continuation or thread data but have no other arguments @@ -707,7 +711,7 @@ (define (prim:arg-count? exp) (and (prim? exp) (member exp '(error Cyc-write Cyc-display - string->number string-append + string->number2 string->number string-append + - * /)))) ;; Does primitive allocate an object? diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 67ae34a0..616f5e7d 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -502,6 +502,7 @@ char->integer integer->char string->number + string->number2 string-append string-cmp list->string diff --git a/scheme/eval.sld b/scheme/eval.sld index e91d6e55..fa053227 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -233,6 +233,7 @@ (list 'char->integer char->integer) (list 'integer->char integer->char) (list 'string->number string->number) + (list 'string->number2 string->number2) (list 'string-cmp string-cmp) (list 'string-append string-append) (list 'list->string list->string) diff --git a/scheme/read.sld b/scheme/read.sld index 0b9d00ae..9859d870 100644 --- a/scheme/read.sld +++ b/scheme/read.sld @@ -331,13 +331,13 @@ (parse-atom num))))) ((eq? #\b next-c) (parse-number fp toks all? parens ptbl - 2 (lambda (num) (string->number (list->string num) 2)))) + 2 (lambda (num) (string->number2 (list->string num) 2)))) ((eq? #\o next-c) (parse-number fp toks all? parens ptbl - 8 (lambda (num) (string->number (list->string num) 8)))) + 8 (lambda (num) (string->number2 (list->string num) 8)))) ((eq? #\x next-c) (parse-number fp toks all? parens ptbl - 16 (lambda (num) (string->number (list->string num) 16)))) + 16 (lambda (num) (string->number2 (list->string num) 16)))) ;; Vector ((eq? #\( next-c) (let ((sub (parse fp '() '() #t #f (+ parens 1) ptbl)) @@ -466,7 +466,7 @@ (define (parse-atom a) (cond ((token-numeric? a) - (string->number (list->string a))) + (string->number2 (list->string a))) (else (string->symbol (list->string a))))) diff --git a/tests/unit-tests.scm b/tests/unit-tests.scm index 7b6d79aa..61529d15 100644 --- a/tests/unit-tests.scm +++ b/tests/unit-tests.scm @@ -181,10 +181,10 @@ (assert:equal "" (string-append "test") "test") (assert:equal "" (string-append "ab" "cdefgh ij" "klmno" "p" "q" "rs " "tuv" "w" " x " "yz") "abcdefgh ijklmnopqrs tuvw x yz") -(assert:equal "" (string->number "0") 0) -(assert:equal "" (string->number "42") 42) -;(assert:equal "" (string->number "343243243232") ;; Note no bignum support -(assert:equal "" (string->number "3.14159") 3.14159) +(assert:equal "" (string->number2 "0") 0) +(assert:equal "" (string->number2 "42") 42) +;(assert:equal "" (string->number2 "343243243232") ;; Note no bignum support +(assert:equal "" (string->number2 "3.14159") 3.14159) (assert:equal "" (list->string (list #\A #\B #\C)) "ABC") (assert:equal "" (list->string (list #\A)) "A") (assert:equal "" (list->string (list)) "")