Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

number->string and string->number edge cases (issue 29)

Browse source
This commit is contained in:
Alex Shinn 2010-01-24 22:03:36 +09:00
parent 8046a3c139
commit b8e816c460
1 changed files with 20 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lib/init.scm
View file

@ -488,24 +488,32 @@
(and (<= 65 (char->integer (char-upcase ch)) 70) (and (<= 65 (char->integer (char-upcase ch)) 70)
(- (char->integer (char-upcase ch)) 55)))) (- (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))) (if (if (null? o) #t (eq? 10 (car o)))
(call-with-output-string (lambda (out) (write n out))) (call-with-output-string (lambda (out) (write num out)))
(let lp ((n n) (d (car o)) (res '())) (let lp ((n (abs num)) (d (car o)) (res '()))
(if (> n 0) (if (> n 0)
(lp (quotient n d) d (cons (digit-char (remainder n d)) res)) (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) (define (string->number str . o)
(let ((res (let ((res
(if (if (null? o) #t (eq? 10 (car o))) (cond
(call-with-input-string str (lambda (in) (read in))) ((= 0 (string-length str))
(let ((len (string-length str))) #f)
(let lp ((i 0) (d (car o)) (acc 0)) ((if (null? o)
(if (>= i len) #t
acc (if (eq? 10 (car o)) #t (eq? #\# (string-ref str 0))))
(let ((v (digit-value (string-ref str i)))) (call-with-input-string str (lambda (in) (read in))))
(and v (lp (+ i 1) d (+ (* acc d) v)))))))))) (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))) (and (number? res) res)))
;; vector utils ;; vector utils