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)
(- (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