Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 11:46:37 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Properly handling +nan.0 and infinite comparisons.

Browse source
This commit is contained in:
Alex Shinn 2012-11-10 20:53:16 +09:00
parent f792329eed
commit 122d8b8a00
2 changed files with 42 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
bignum.c
View file

@ -1528,7 +1528,16 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1); r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
break; break;
case SEXP_NUM_FLO_BIG: case SEXP_NUM_FLO_BIG:
a = tmp = sexp_double_to_bignum(ctx, sexp_flonum_value(a)); f = sexp_flonum_value(a);
if (isinf(f)) {
r = f > 0 ? SEXP_ONE : SEXP_NEG_ONE;
break;
} else if (isnan(f)) {
r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", a);
break;
} else {
a = tmp = sexp_double_to_bignum(ctx, f);
}
/* ... FALLTHROUGH ... */ /* ... FALLTHROUGH ... */
case SEXP_NUM_BIG_BIG: case SEXP_NUM_BIG_BIG:
r = sexp_make_fixnum(sexp_bignum_compare(a, b)); r = sexp_make_fixnum(sexp_bignum_compare(a, b));
@ -1536,8 +1545,14 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
#if SEXP_USE_RATIOS #if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT: case SEXP_NUM_FLO_RAT:
f = sexp_flonum_value(a); f = sexp_flonum_value(a);
g = sexp_ratio_to_double(b); if (isinf(f)) {
r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1); r = f > 0 ? SEXP_ONE : SEXP_NEG_ONE;
} else if (isnan(f)) {
r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", a);
} else {
g = sexp_ratio_to_double(b);
r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
}
break; break;
case SEXP_NUM_FIX_RAT: case SEXP_NUM_FIX_RAT:
case SEXP_NUM_BIG_RAT: case SEXP_NUM_BIG_RAT:

30
vm.c
View file

@ -1750,8 +1750,14 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
_ARG1 = sexp_make_boolean(i); _ARG1 = sexp_make_boolean(i);
} else { } else {
_ARG1 = sexp_compare(ctx, tmp1, tmp2); _ARG1 = sexp_compare(ctx, tmp1, tmp2);
sexp_check_exception(); if (sexp_exceptionp(_ARG1)) {
_ARG1 = sexp_make_boolean(sexp_unbox_fixnum(_ARG1) < 0); if (strcmp("can't compare NaN", sexp_string_data(sexp_exception_message(_ARG1))) == 0)
_ARG1 = SEXP_FALSE;
else
goto call_error_handler;
} else {
_ARG1 = sexp_make_boolean(sexp_unbox_fixnum(_ARG1) < 0);
}
} }
#else #else
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
@ -1775,8 +1781,14 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
_ARG1 = sexp_make_boolean(i); _ARG1 = sexp_make_boolean(i);
} else { } else {
_ARG1 = sexp_compare(ctx, tmp1, tmp2); _ARG1 = sexp_compare(ctx, tmp1, tmp2);
sexp_check_exception(); if (sexp_exceptionp(_ARG1)) {
_ARG1 = sexp_make_boolean(sexp_unbox_fixnum(_ARG1) <= 0); if (strcmp("can't compare NaN", sexp_string_data(sexp_exception_message(_ARG1))) == 0)
_ARG1 = SEXP_FALSE;
else
goto call_error_handler;
} else {
_ARG1 = sexp_make_boolean(sexp_unbox_fixnum(_ARG1) <= 0);
}
} }
#else #else
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
@ -1828,8 +1840,14 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
#endif #endif
/* neither is complex */ /* neither is complex */
_ARG1 = sexp_compare(ctx, tmp1, tmp2); _ARG1 = sexp_compare(ctx, tmp1, tmp2);
sexp_check_exception(); if (sexp_exceptionp(_ARG1)) {
_ARG1 = sexp_make_boolean(_ARG1 == SEXP_ZERO); if (strcmp("can't compare NaN", sexp_string_data(sexp_exception_message(_ARG1))) == 0)
_ARG1 = SEXP_FALSE;
else
goto call_error_handler;
} else {
_ARG1 = sexp_make_boolean(_ARG1 == SEXP_ZERO);
}
} }
#else #else
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS