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

fixing edge cases

Browse source
This commit is contained in:
Alex Shinn 2019-03-12 00:37:00 +08:00
parent 80b360b800
commit cf1f333731
2 changed files with 17 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lib/chibi/show-test.sld
View file

@ -92,6 +92,13 @@
(test "-3141.59" (show #f (with ((decimal-align 5)) (numeric -3141.59)))) (test "-3141.59" (show #f (with ((decimal-align 5)) (numeric -3141.59))))
(test "-31415.9" (show #f (with ((decimal-align 5)) (numeric -31415.9)))) (test "-31415.9" (show #f (with ((decimal-align 5)) (numeric -31415.9))))
(test "+inf.0" (show #f +inf.0))
(test "-inf.0" (show #f -inf.0))
(test "+nan.0" (show #f +nan.0))
(test "+inf.0" (show #f (numeric +inf.0)))
(test "-inf.0" (show #f (numeric -inf.0)))
(test "+nan.0" (show #f (numeric +nan.0)))
(cond (cond
((exact? (/ 1 3)) ;; exact rationals ((exact? (/ 1 3)) ;; exact rationals
(test "333.333333333333333333333333333333" (test "333.333333333333333333333333333333"
@ -279,6 +286,7 @@
(test "1.23" (show #f (numeric/fitted 4 1.2345 10 2))) (test "1.23" (show #f (numeric/fitted 4 1.2345 10 2)))
(test "1.00" (show #f (numeric/fitted 4 1 10 2))) (test "1.00" (show #f (numeric/fitted 4 1 10 2)))
(test "#.##" (show #f (numeric/fitted 4 12.345 10 2))) (test "#.##" (show #f (numeric/fitted 4 12.345 10 2)))
(test "#" (show #f (numeric/fitted 1 12.345 10 0)))
;; padding/trimming ;; padding/trimming

14
lib/chibi/show/write.scm
View file

@ -321,8 +321,10 @@
(wrap-comma n)))) (wrap-comma n))))
;; Format a single real number with padding as necessary. ;; Format a single real number with padding as necessary.
(define (format n sign-rule) (define (format n sign-rule)
(let ((s (wrap-sign n sign-rule))) (cond
(let* ((dec-pos (if decimal-align ((finite? n)
(let* ((s (wrap-sign n sign-rule))
(dec-pos (if decimal-align
(string-cursor->index (string-cursor->index
s s
(if (char? dec-sep) (if (char? dec-sep)
@ -333,7 +335,9 @@
(diff (- (or decimal-align 0) dec-pos 1))) (diff (- (or decimal-align 0) dec-pos 1)))
(if (positive? diff) (if (positive? diff)
(string-append (make-string diff #\space) s) (string-append (make-string diff #\space) s)
s)))) s)))
(else
(number->string n))))
;; Write any number. ;; Write any number.
(define (write-complex n) (define (write-complex n)
(cond (cond
@ -369,7 +373,7 @@
(if (= base 1024) names2 names10))) (if (= base 1024) names2 names10)))
(k (min (exact ((if (negative? log-n) ceiling floor) (k (min (exact ((if (negative? log-n) ceiling floor)
(/ (abs log-n) (log base)))) (/ (abs log-n) (log base))))
(vector-length names))) (- (vector-length names) 1)))
(n2 (round-to (/ n (expt base (if (negative? log-n) (- k) k))) (n2 (round-to (/ n (expt base (if (negative? log-n) (- k) k)))
10))) 10)))
(each (if (integer? n2) (each (if (integer? n2)
@ -391,7 +395,7 @@
(let ((prec (if (and (pair? args) (pair? (cdr args))) (let ((prec (if (and (pair? args) (pair? (cdr args)))
(cadr args) (cadr args)
precision))) precision)))
(if prec (if (and prec (not (zero? prec)))
(let* ((dec-sep (let* ((dec-sep
(or decimal-sep (or decimal-sep
(if (eqv? #\. comma-sep) #\, #\.))) (if (eqv? #\. comma-sep) #\, #\.)))