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

conditionally using 17 digits of precision in flonum output when needed

Browse source
This commit is contained in:
Alex Shinn 2017-08-26 21:35:43 +09:00
parent f1eab48fd1
commit d9a40fbc61
2 changed files with 37 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
sexp.c
View file

@ -1865,7 +1865,7 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
unsigned long len, c; unsigned long len, c;
long i=0; long i=0;
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
double f; double f, ftmp;
#endif #endif
sexp x, *elts; sexp x, *elts;
char *str=NULL, numbuf[NUMBUF_LEN]; char *str=NULL, numbuf[NUMBUF_LEN];
@ -1913,7 +1913,10 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
} else } else
#endif #endif
{ {
i = snprintf(numbuf, NUMBUF_LEN, "%.16g", f); i = snprintf(numbuf, NUMBUF_LEN, "%.16lg", f);
if (i >= 16 && sscanf(numbuf, "%lg", &ftmp) == 1 && ftmp != f) {
i = snprintf(numbuf, NUMBUF_LEN, "%.17lg", f);
}
if (!strchr(numbuf, '.') && !strchr(numbuf, 'e')) { if (!strchr(numbuf, '.') && !strchr(numbuf, 'e')) {
numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0'; numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0';
} }
@ -2434,7 +2437,7 @@ sexp sexp_read_polar_tail (sexp ctx, sexp in, sexp magnitude) {
sexp sexp_read_float_tail (sexp ctx, sexp in, double whole, int negp) { sexp sexp_read_float_tail (sexp ctx, sexp in, double whole, int negp) {
int c, c2; int c, c2;
sexp exponent=SEXP_VOID; sexp exponent=SEXP_VOID;
double val=0.0, scale=0.1, e=0.0; long double val=0.0, scale=0.1, e=0.0;
sexp_gc_var1(res); sexp_gc_var1(res);
sexp_gc_preserve1(ctx, res); sexp_gc_preserve1(ctx, res);
for (c=sexp_read_char(ctx, in); sexp_isdigit(c); for (c=sexp_read_char(ctx, in); sexp_isdigit(c);
@ -2475,7 +2478,7 @@ sexp sexp_read_float_tail (sexp ctx, sexp in, double whole, int negp) {
#endif #endif
} }
if (e != 0.0) if (e != 0.0)
val = abs(e) > 300 ? exp(log(val) + e*M_LN10) : val * pow(10, e); val = abs(e) > 320 ? exp(log(val) + e*M_LN10) : val * pow(10, e);
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
res = sexp_make_flonum(ctx, val); res = sexp_make_flonum(ctx, val);
#else #else

30
tests/r7rs-tests.scm
View file

@ -2344,6 +2344,36 @@
;;(test-numeric-syntax "#e1.0+1.0i" (make-rectangular 1 1) "1+1i" "1+i") ;;(test-numeric-syntax "#e1.0+1.0i" (make-rectangular 1 1) "1+1i" "1+i")
;;(test-numeric-syntax "#i1.0+1.0i" (make-rectangular 1.0 1.0) "1.0+1.0i" "1.+1.i") ;;(test-numeric-syntax "#i1.0+1.0i" (make-rectangular 1.0 1.0) "1.0+1.0i" "1.+1.i")
(define-syntax test-precision
(syntax-rules ()
((test-round-trip str alt ...)
(let* ((n (string->number str))
(str2 (number->string n))
(accepted (list str alt ...))
(ls (member str2 accepted)))
(test-assert (string-append "(member? " str2 " "
(let ((out (open-output-string)))
(write accepted out)
(get-output-string out))
")")
(pair? ls))
(when (pair? ls)
(test-assert (string-append "(eqv?: " str " " str2 ")")
(eqv? n (string->number (car ls)))))))))
;; these all assume double precision, need to add alternatives for single
(test-precision "-1.7976931348623157e+308")
(test-precision "4.940656458412465e-324")
(test-precision "9.881312916824931e-324")
(test-precision "1.48219693752374e-323")
(test-precision "1.976262583364986e-323")
(test-precision "2.470328229206233e-323")
(test-precision "2.420921664622108e-322")
(test-precision "2.420921664622108e-320")
(test-precision "1.4489974452386991")
(test-precision "0.14285714285714282")
(test-precision "1.7976931348623157e+308")
(test-end) (test-end)
(test-end) (test-end)