From b8e816c4603d4692b6fa31e94e856aa5d55725e7 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 24 Jan 2010 22:03:36 +0900 Subject: [PATCH] number->string and string->number edge cases (issue 29) --- lib/init.scm | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/lib/init.scm b/lib/init.scm index 853e2f99..b0bea0a7 100644 --- a/lib/init.scm +++ b/lib/init.scm @@ -488,24 +488,32 @@ (and (<= 65 (char->integer (char-upcase ch)) 70) (- (char->integer (char-upcase ch)) 55)))) -(define (number->string n . o) +(define (number->string num . o) (if (if (null? o) #t (eq? 10 (car o))) - (call-with-output-string (lambda (out) (write n out))) - (let lp ((n n) (d (car o)) (res '())) + (call-with-output-string (lambda (out) (write num out))) + (let lp ((n (abs num)) (d (car o)) (res '())) (if (> n 0) (lp (quotient n d) d (cons (digit-char (remainder n d)) res)) - (if (null? res) "0" (list->string res)))))) + (if (null? res) + "0" + (list->string (if (negative? num) (cons #\- res) res))))))) (define (string->number str . o) (let ((res - (if (if (null? o) #t (eq? 10 (car o))) - (call-with-input-string str (lambda (in) (read in))) - (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)))))))))) + (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