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

support exact scaling of bignum literals via moderate sized exponents

Browse source
This commit is contained in:
Alex Shinn 2018-12-03 23:05:00 +08:00
parent 13311e78c5
commit 11ccfcb5de
2 changed files with 33 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
bignum.c
View file

@ -260,8 +260,8 @@ sexp sexp_bignum_fxrem (sexp ctx, sexp a, sexp_sint_t b) {
sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init, sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init,
signed char sign, sexp_uint_t base) { signed char sign, sexp_uint_t base) {
int c, digit; int c, digit;
sexp_gc_var1(res); sexp_gc_var3(res, tmp, imag);
sexp_gc_preserve1(ctx, res); sexp_gc_preserve3(ctx, res, tmp, imag);
res = sexp_make_bignum(ctx, SEXP_INIT_BIGNUM_SIZE); res = sexp_make_bignum(ctx, SEXP_INIT_BIGNUM_SIZE);
sexp_bignum_sign(res) = sign; sexp_bignum_sign(res) = sign;
sexp_bignum_data(res)[0] = init; sexp_bignum_data(res)[0] = init;
@ -275,9 +275,32 @@ sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init,
if (c=='.' || c=='e' || c=='E') { if (c=='.' || c=='e' || c=='E') {
if (base != 10) { if (base != 10) {
res = sexp_read_error(ctx, "found non-base 10 float", SEXP_NULL, in); res = sexp_read_error(ctx, "found non-base 10 float", SEXP_NULL, in);
} else { } else if (c=='.') {
if (c!='.') sexp_push_char(ctx, c, in); /* push the e back */
res = sexp_read_float_tail(ctx, in, sexp_bignum_to_double(res), (sign==-1)); res = sexp_read_float_tail(ctx, in, sexp_bignum_to_double(res), (sign==-1));
} else {
tmp = sexp_read_number(ctx, in, base, 0);
#if SEXP_USE_COMPLEX
if (sexp_complexp(tmp)) {
imag = sexp_complex_imag(tmp);
tmp = sexp_complex_real(tmp);
} else {
imag = SEXP_ZERO;
}
#endif
if (sexp_exceptionp(tmp)) {
res = tmp;
} else if (sexp_fixnump(tmp) && labs(sexp_unbox_fixnum(tmp)) < 100*1024*1024) {
tmp = sexp_expt(ctx, SEXP_TEN, tmp);
res = sexp_mul(ctx, res, tmp);
} else {
tmp = sexp_exact_to_inexact(ctx, NULL, 2, tmp);
tmp = sexp_expt(ctx, SEXP_TEN, tmp);
res = sexp_mul(ctx, res, tmp);
}
#if SEXP_USE_COMPLEX
if (imag != SEXP_ZERO && !sexp_exceptionp(res))
res = sexp_make_complex(ctx, res, imag);
#endif
} }
#if SEXP_USE_RATIOS #if SEXP_USE_RATIOS
} else if (c=='/') { } else if (c=='/') {
@ -298,7 +321,7 @@ sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init,
} else { } else {
sexp_push_char(ctx, c, in); sexp_push_char(ctx, c, in);
} }
sexp_gc_release1(ctx); sexp_gc_release3(ctx);
return sexp_bignum_normalize(res); return sexp_bignum_normalize(res);
} }

5
lib/chibi/numeric-test.sld
View file

@ -322,6 +322,11 @@
(test -10100 (/ (factorial 101) (- (factorial 99)))) (test -10100 (/ (factorial 101) (- (factorial 99))))
(test 100 (/ (- (factorial 100)) (- (factorial 98)) 99)) (test 100 (/ (- (factorial 100)) (- (factorial 98)) 99))
(test 100000000000000000000000
(string->number "100000000000000000000e3"))
(test 1/100+8i
(string->number "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-102+8i"))
(test #t (< 1/2 1.0)) (test #t (< 1/2 1.0))
(test #t (< 1.0 3/2)) (test #t (< 1.0 3/2))
(test #t (< 1/2 1.5)) (test #t (< 1/2 1.5))