Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-14 08:27:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

raising an error on non-numeric input to number->string

Browse source
This commit is contained in:
Alex Shinn 2012-07-19 21:37:15 +09:00
parent 57b2bc281d
commit a9784b56f8
1 changed files with 16 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lib/init-7.scm
View file

@ -372,15 +372,22 @@
(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 num)
(call-with-output-string (lambda (out) (write num out))))
(define (number->string num . o) (define (number->string num . o)
(if (if (null? o) #t (eq? 10 (car o))) (cond
(call-with-output-string (lambda (out) (write num out))) ((not (number? num))
(let lp ((n (abs num)) (d (car o)) (res '())) (error "not a number" num))
(if (> n 0) ((if (null? o) #t (eq? 10 (car o)))
(lp (quotient n d) d (cons (digit-char (remainder n d)) res)) (%number->string num))
(if (null? res) (else
"0" (let lp ((n (abs num)) (d (car o)) (res '()))
(list->string (if (negative? num) (cons #\- res) res))))))) (if (> n 0)
(lp (quotient n d) d (cons (digit-char (remainder n d)) res))
(if (null? res)
"0"
(list->string (if (negative? num) (cons #\- res) res))))))))
(define (list->string ls) (define (list->string ls)
(call-with-output-string (call-with-output-string
@ -626,7 +633,7 @@
(define forms (if ellipsis-specified? (cdr (cddr expr)) (cddr expr))) (define forms (if ellipsis-specified? (cdr (cddr expr)) (cddr expr)))
(define (next-symbol s) (define (next-symbol s)
(set! count (+ count 1)) (set! count (+ count 1))
(rename (string->symbol (string-append s (number->string count))))) (rename (string->symbol (string-append s (%number->string count)))))
(define (expand-pattern pat tmpl) (define (expand-pattern pat tmpl)
(let lp ((p (cdr pat)) (let lp ((p (cdr pat))
(x (list _cdr _expr)) (x (list _cdr _expr))