adjust for rounding up converting from fixnum to double in exact-integer-sqrt (fixes #786)

This commit is contained in:
Alex Shinn 2021-11-08 09:27:50 +09:00
parent a92289ceb9
commit 182048ed9a
2 changed files with 10 additions and 2 deletions

9
eval.c
View file

@ -1623,8 +1623,8 @@ sexp sexp_inexact_sqrt (sexp ctx, sexp self, sexp_sint_t n, sexp z) {
if (sexp_flonump(z)) if (sexp_flonump(z))
d = sexp_flonum_value(z); d = sexp_flonum_value(z);
else if (sexp_fixnump(z)) else if (sexp_fixnump(z))
d = (double)sexp_unbox_fixnum(z); d = (double)sexp_unbox_fixnum(z); /* may be larger or smaller than z */
maybe_convert_ratio(ctx, z) /* XXXX add ratio sqrt */ maybe_convert_ratio(ctx, z) /* TODO: add ratio sqrt */
maybe_convert_complex(z, sexp_complex_sqrt) maybe_convert_complex(z, sexp_complex_sqrt)
else else
return sexp_type_exception(ctx, self, SEXP_NUMBER, z); return sexp_type_exception(ctx, self, SEXP_NUMBER, z);
@ -1664,6 +1664,11 @@ sexp sexp_exact_sqrt (sexp ctx, sexp self, sexp_sint_t n, sexp z) {
if (!sexp_exceptionp(res)) { if (!sexp_exceptionp(res)) {
rem = sexp_mul(ctx, res, res); rem = sexp_mul(ctx, res, res);
rem = sexp_sub(ctx, z, rem); rem = sexp_sub(ctx, z, rem);
if (sexp_negativep(rem)) {
res = sexp_sub(ctx, res, SEXP_ONE);
rem = sexp_mul(ctx, res, res);
rem = sexp_sub(ctx, z, rem);
}
res = sexp_cons(ctx, res, rem); res = sexp_cons(ctx, res, rem);
} }
} }

View file

@ -311,6 +311,9 @@
(- 340282366920938463463374607431768211456 (- 340282366920938463463374607431768211456
340282366920938463426481119284349108225)) 340282366920938463426481119284349108225))
(test '(2147483647 4294967294)
(call-with-values (lambda () (exact-integer-sqrt (- (expt 2 62) 1)))
list))
(test '(10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 0) (test '(10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 0)
(call-with-values (lambda () (exact-integer-sqrt (expt 10 308))) (call-with-values (lambda () (exact-integer-sqrt (expt 10 308)))
list)) list))