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

make mixed inexact/exact ordering consistent, converting to exact for fixnums and ratios instead of just bignums (issue #812)

Browse source
This commit is contained in:
Alex Shinn 2022-02-12 07:50:58 +09:00
parent eb6a2eeb78
commit 82d61b3d8e
2 changed files with 8 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
bignum.c
View file

@ -1886,12 +1886,13 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
r = sexp_make_fixnum(sexp_unbox_fixnum(a) - sexp_unbox_fixnum(b)); r = sexp_make_fixnum(sexp_unbox_fixnum(a) - sexp_unbox_fixnum(b));
break; break;
case SEXP_NUM_FIX_FLO: case SEXP_NUM_FIX_FLO:
f = sexp_fixnum_to_double(a); if (isinf(sexp_flonum_value(b))) {
g = sexp_flonum_value(b); r = sexp_flonum_value(b) > 0 ? SEXP_NEG_ONE : SEXP_ONE;
if (isnan(g)) } else if (isnan(sexp_flonum_value(b))) {
r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", b); r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", b);
else } else {
r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1); r = sexp_compare(ctx, a, tmp=sexp_inexact_to_exact(ctx, NULL, 1, b));
}
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
if ((sexp_bignum_hi(b) > 1) || if ((sexp_bignum_hi(b) > 1) ||
@ -1933,8 +1934,7 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
} else if (isnan(f)) { } else if (isnan(f)) {
r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", a); r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", a);
} else { } else {
g = sexp_ratio_to_double(ctx, b); r = sexp_compare(ctx, tmp=sexp_inexact_to_exact(ctx, NULL, 1, a), b);
r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
} }
break; break;
case SEXP_NUM_FIX_RAT: case SEXP_NUM_FIX_RAT:

1
tests/r7rs-tests.scm
View file

@ -798,6 +798,7 @@
(test #f (< +nan.0 0.0)) (test #f (< +nan.0 0.0))
(test #f (> +nan.0 0.0)) (test #f (> +nan.0 0.0))
(test '(#t #f) (list (<= 1 1 2) (<= 2 1 3))) (test '(#t #f) (list (<= 1 1 2) (<= 2 1 3)))
(test #f (= 9007199254740992.0 9007199254740993))
;; From R7RS 6.2.6 Numerical operations: ;; From R7RS 6.2.6 Numerical operations:
;; ;;