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

Fixing complex = comparisons.

Browse source
This commit is contained in:
Alex Shinn 2012-03-22 23:21:15 +09:00
parent c8b93f2c05
commit 13a498c69d
1 changed files with 27 additions and 10 deletions

37
vm.c
View file

@ -1643,21 +1643,38 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
i = tmp1 == tmp2;
#if SEXP_USE_BIGNUMS
_ARG1 = sexp_make_boolean(i);
} else {
#if SEXP_USE_COMPLEX
} else if (sexp_complexp(tmp1)) {
if (!sexp_complexp(tmp2)) {
_ARG1 = SEXP_FALSE;
} else {
i = (sexp_complex_real(tmp1) == sexp_complex_real(tmp2)
|| (sexp_flonump(tmp1) && (sexp_flonum_value(tmp1) == (sexp_flonump(tmp2) ? sexp_flonum_value(tmp2) : sexp_unbox_fixnum(tmp2))))
|| (sexp_flonump(tmp2) && (sexp_flonum_value(tmp2) == sexp_unbox_fixnum(tmp2))));
_ARG1 = sexp_make_boolean(i);
if (sexp_complexp(tmp1)) {
if (sexp_flonump(sexp_complex_imag(tmp1))
&& sexp_flonum_value(sexp_complex_imag(tmp1)) == 0.0) {
tmp1 = sexp_complex_real(tmp1);
} else if (sexp_complexp(tmp2)) { /* both complex */
_ARG1 = sexp_make_boolean(
(sexp_compare(ctx, sexp_complex_real(tmp1), sexp_complex_real(tmp2))
== SEXP_ZERO)
&& (sexp_compare(ctx, sexp_complex_imag(tmp1), sexp_complex_imag(tmp2))
== SEXP_ZERO));
break;
} else if (sexp_numberp(tmp2)) {
_ARG1 = SEXP_FALSE;
break;
}
}
if (sexp_complexp(tmp2)) {
if (sexp_flonump(sexp_complex_imag(tmp2))
&& sexp_flonum_value(sexp_complex_imag(tmp2)) == 0.0) {
tmp2 = sexp_complex_real(tmp2);
} else if (sexp_numberp(tmp1)) {
_ARG1 = SEXP_FALSE;
break;
}
}
#endif
} else {
/* neither is complex */
_ARG1 = sexp_compare(ctx, tmp1, tmp2);
sexp_check_exception();
_ARG1 = sexp_make_boolean(sexp_unbox_fixnum(_ARG1) == 0);
_ARG1 = sexp_make_boolean(_ARG1 == SEXP_ZERO);
}
#else
#if SEXP_USE_FLONUMS