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 "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 3)))

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

@ -365,21 +365,25 @@
(lambda (n . o)
(let-optionals* o ((base 1000)
(separator ""))
(let* ((log-n (log n))
(names (if (negative? log-n)
(if (= base 1024) names-2 names-10)
(if (= base 1024) names2 names10)))
(k (min (exact ((if (negative? log-n) ceiling floor)
(/ (abs log-n) (log base))))
(- (vector-length names) 1)))
(n2 (round-to (/ n (expt base (if (negative? log-n) (- k) k)))
10)))
(each (if (integer? n2)
(number->string (exact n2))
(inexact n2))
;; (if (zero? k) "" separator)
separator
(vector-ref names k)))))))
(if (zero? n)
"0"
(let* ((log-n (log (abs n)))
(names (if (negative? log-n)
(if (= base 1024) names-2 names-10)
(if (= base 1024) names2 names10)))
(k (min (exact ((if (negative? log-n) ceiling floor)
(/ (abs log-n) (log base))))
(- (vector-length names) 1)))
(n2 (round-to (/ (abs n)
(expt base (if (negative? log-n) (- k) k)))
10)))
(each (if (negative? n) "-" "")
(if (integer? n2)
(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.
;; Needs to be wrapped in PADDED if you want to expand to the width.