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

handle non-positive numbers in numeric/si (fixes issue #801)

Browse source
This commit is contained in:
Alex Shinn 2021-12-25 10:55:58 +09:00
parent f51f61098c
commit 58e9715c2b
2 changed files with 22 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lib/srfi/166/test.sld
View file

@ -279,6 +279,9 @@
(test "12.3µm" (show #f (numeric/si 1.23e-5 1000) "m")) ;? (test "12.3µm" (show #f (numeric/si 1.23e-5 1000) "m")) ;?
(test "1.2µm" (show #f (numeric/si 1.23e-6 1000) "m")) (test "1.2µm" (show #f (numeric/si 1.23e-6 1000) "m"))
(test "1.2 µm" (show #f (numeric/si 1.23e-6 1000 " ") "m")) (test "1.2 µm" (show #f (numeric/si 1.23e-6 1000 " ") "m"))
(test "0" (show #f (numeric/si 0)))
(test "-608" (show #f (numeric/si -608)))
(test "-4k" (show #f (numeric/si -3986)))
(test "1,234,567" (show #f (numeric/comma 1234567))) (test "1,234,567" (show #f (numeric/comma 1234567)))
(test "1,234,567" (show #f (numeric/comma 1234567 3))) (test "1,234,567" (show #f (numeric/comma 1234567 3)))

34
lib/srfi/166/write.scm
View file

@ -365,21 +365,25 @@
(lambda (n . o) (lambda (n . o)
(let-optionals* o ((base 1000) (let-optionals* o ((base 1000)
(separator "")) (separator ""))
(let* ((log-n (log n)) (if (zero? n)
(names (if (negative? log-n) "0"
(if (= base 1024) names-2 names-10) (let* ((log-n (log (abs n)))
(if (= base 1024) names2 names10))) (names (if (negative? log-n)
(k (min (exact ((if (negative? log-n) ceiling floor) (if (= base 1024) names-2 names-10)
(/ (abs log-n) (log base)))) (if (= base 1024) names2 names10)))
(- (vector-length names) 1))) (k (min (exact ((if (negative? log-n) ceiling floor)
(n2 (round-to (/ n (expt base (if (negative? log-n) (- k) k))) (/ (abs log-n) (log base))))
10))) (- (vector-length names) 1)))
(each (if (integer? n2) (n2 (round-to (/ (abs n)
(number->string (exact n2)) (expt base (if (negative? log-n) (- k) k)))
(inexact n2)) 10)))
;; (if (zero? k) "" separator) (each (if (negative? n) "-" "")
separator (if (integer? n2)
(vector-ref names k))))))) (number->string (exact n2))
(inexact n2))
;; (if (zero? k) "" separator)
separator
(vector-ref names k))))))))
;; Force a number into a fixed width, print as #'s if doesn't fit. ;; Force a number into a fixed width, print as #'s if doesn't fit.
;; Needs to be wrapped in PADDED if you want to expand to the width. ;; Needs to be wrapped in PADDED if you want to expand to the width.