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

Corner cases in complex infinities. Fixes issue #331.

Browse source
This commit is contained in:
Alex Shinn 2016-05-11 23:19:22 +09:00
parent 0113e1e5d5
commit 5ab99635c5
3 changed files with 31 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
eval.c
View file

@ -1755,7 +1755,7 @@ sexp sexp_inexact_to_exact (sexp ctx, sexp self, sexp_sint_t n, sexp z) {
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
else if (sexp_flonump(z)) { else if (sexp_flonump(z)) {
if (isinf(sexp_flonum_value(z)) || isnan(sexp_flonum_value(z))) { if (isinf(sexp_flonum_value(z)) || isnan(sexp_flonum_value(z))) {
res = sexp_xtype_exception(ctx, self, "exact: not an finite number", z); res = sexp_xtype_exception(ctx, self, "exact: not a finite number", z);
} else if (sexp_flonum_value(z) != trunc(sexp_flonum_value(z))) { } else if (sexp_flonum_value(z) != trunc(sexp_flonum_value(z))) {
#if SEXP_USE_RATIOS #if SEXP_USE_RATIOS
res = sexp_double_to_ratio(ctx, sexp_flonum_value(z)); res = sexp_double_to_ratio(ctx, sexp_flonum_value(z));
@ -1778,7 +1778,11 @@ sexp sexp_inexact_to_exact (sexp ctx, sexp self, sexp_sint_t n, sexp z) {
res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO); res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO);
sexp_complex_real(res) = sexp_inexact_to_exact(ctx, self, 1, sexp_complex_real(z)); sexp_complex_real(res) = sexp_inexact_to_exact(ctx, self, 1, sexp_complex_real(z));
sexp_complex_imag(res) = sexp_inexact_to_exact(ctx, self, 1, sexp_complex_imag(z)); sexp_complex_imag(res) = sexp_inexact_to_exact(ctx, self, 1, sexp_complex_imag(z));
if (sexp_complex_imag(res) == SEXP_ZERO) if (sexp_exceptionp(sexp_complex_real(res)))
res = sexp_complex_real(res);
else if (sexp_exceptionp(sexp_complex_imag(res)))
res = sexp_complex_imag(res);
else if (sexp_complex_imag(res) == SEXP_ZERO)
res = sexp_complex_real(res); res = sexp_complex_real(res);
sexp_gc_release1(ctx); sexp_gc_release1(ctx);
} }

5
lib/srfi/38.scm
View file

@ -369,7 +369,10 @@
((#\o) (read-char in) (read-number 8)) ((#\o) (read-char in) (read-number 8))
((#\b) (read-char in) (read-number 2)) ((#\b) (read-char in) (read-number 2))
((#\i) (read-char in) (exact->inexact (read-one in))) ((#\i) (read-char in) (exact->inexact (read-one in)))
((#\e) (string->number (read-name #\# in))) ((#\e)
(let ((s (read-name #\# in)))
(or (string->number s)
(read-one (open-input-string (substring s 2))))))
((#\u #\v) ((#\u #\v)
(if (eqv? #\v (peek-char in)) (if (eqv? #\v (peek-char in))
(read-char in)) (read-char in))

24
sexp.c
View file

@ -2365,6 +2365,8 @@ sexp sexp_read_polar_tail (sexp ctx, sexp in, sexp magnitude) {
sexp_complex_real(res) = sexp_mul(ctx, magnitude, sexp_complex_real(res)); sexp_complex_real(res) = sexp_mul(ctx, magnitude, sexp_complex_real(res));
sexp_complex_imag(res) = sexp_sin(ctx, NULL, 1, theta); sexp_complex_imag(res) = sexp_sin(ctx, NULL, 1, theta);
sexp_complex_imag(res) = sexp_mul(ctx, magnitude, sexp_complex_imag(res)); sexp_complex_imag(res) = sexp_mul(ctx, magnitude, sexp_complex_imag(res));
if (sexp_exceptionp(sexp_complex_real(res))) res = sexp_complex_real(res);
if (sexp_exceptionp(sexp_complex_imag(res))) res = sexp_complex_imag(res);
} }
sexp_gc_release2(ctx); sexp_gc_release2(ctx);
return sexp_complex_normalize(res); return sexp_complex_normalize(res);
@ -2550,9 +2552,21 @@ sexp sexp_read_number (sexp ctx, sexp in, int base, int exactp) {
sexp_gc_preserve2(ctx, res, den); sexp_gc_preserve2(ctx, res, den);
res = sexp_make_fixnum(negativep ? -val : val); res = sexp_make_fixnum(negativep ? -val : val);
den = sexp_read_number(ctx, in, base, 0); den = sexp_read_number(ctx, in, base, 0);
if (sexp_flonump(den)) den = sexp_make_fixnum(sexp_flonum_value(den)); if (sexp_exceptionp(den)) {
den = sexp_expt(ctx, SEXP_TEN, den); res = den;
res = sexp_mul(ctx, res, den); } else {
if (sexp_flonump(den)) den = sexp_make_fixnum(sexp_flonum_value(den));
if (sexp_complexp(den)) {
if (sexp_flonump(sexp_complex_real(den)))
sexp_complex_real(den) = sexp_make_fixnum(sexp_flonum_value(sexp_complex_real(den)));
sexp_complex_real(den) = sexp_expt(ctx, SEXP_TEN, sexp_complex_real(den));
sexp_complex_real(den) = sexp_mul(ctx, res, sexp_complex_real(den));
res = den;
} else {
den = sexp_expt(ctx, SEXP_TEN, den);
res = sexp_mul(ctx, res, den);
}
}
sexp_gc_release2(ctx); sexp_gc_release2(ctx);
return res; return res;
} else if (c=='.' || is_precision_indicator(c)) { } else if (c=='.' || is_precision_indicator(c)) {
@ -3147,6 +3161,10 @@ sexp sexp_read_raw (sexp ctx, sexp in, sexp *shares) {
res = tmp; res = tmp;
} else if ((str[6] == 'i' || str[6] == 'I') && str[7] == 0) { } else if ((str[6] == 'i' || str[6] == 'I') && str[7] == 0) {
res = sexp_make_complex(ctx, SEXP_ZERO, tmp); res = sexp_make_complex(ctx, SEXP_ZERO, tmp);
} else if (str[6] == '@') {
res = sexp_substring_cursor(ctx, res, sexp_make_string_cursor(6), SEXP_FALSE);
res = sexp_open_input_string(ctx, res);
res = sexp_read_polar_tail(ctx, res, tmp);
} else if (str[6] == '+' || str[6] == '-') { } else if (str[6] == '+' || str[6] == '-') {
res = sexp_substring_cursor(ctx, res, sexp_make_string_cursor(6), SEXP_FALSE); res = sexp_substring_cursor(ctx, res, sexp_make_string_cursor(6), SEXP_FALSE);
res = sexp_string_to_number(ctx, res, SEXP_TEN); res = sexp_string_to_number(ctx, res, SEXP_TEN);