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

fixing numeric inequalities on NaN

Browse source
This commit is contained in:
Alex Shinn 2012-05-06 14:08:55 +09:00
parent cef6bb6794
commit 14e1cd482f
3 changed files with 40 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
include/chibi/sexp.h
View file

@ -802,6 +802,9 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_shift_epoch(x) ((x)-SEXP_EPOCH_OFFSET) #define sexp_shift_epoch(x) ((x)-SEXP_EPOCH_OFFSET)
#define sexp_unshift_epoch(x) ((x)+SEXP_EPOCH_OFFSET) #define sexp_unshift_epoch(x) ((x)+SEXP_EPOCH_OFFSET)
#define sexp_infp(x) (sexp_flonump(x) && isinf(sexp_flonum_value(x)))
#define sexp_nanp(x) (sexp_flonump(x) && isnan(sexp_flonum_value(x)))
/*************************** field accessors **************************/ /*************************** field accessors **************************/
#if SEXP_USE_SAFE_ACCESSORS #if SEXP_USE_SAFE_ACCESSORS

22
opt/bignum.c
View file

@ -1479,7 +1479,7 @@ sexp sexp_remainder (sexp ctx, sexp a, sexp b) {
sexp sexp_compare (sexp ctx, sexp a, sexp b) { sexp sexp_compare (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b); int at=sexp_number_type(a), bt=sexp_number_type(b);
sexp r=SEXP_VOID; sexp r=SEXP_VOID;
double f; double f, g;
sexp_gc_var1(tmp); sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp); sexp_gc_preserve1(ctx, tmp);
if (at > bt) { if (at > bt) {
@ -1502,27 +1502,31 @@ 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) - sexp_flonum_value(b); f = sexp_fixnum_to_double(a);
r = sexp_make_fixnum(f > 0.0 ? 1 : f == 0.0 ? 0 : -1); g = sexp_flonum_value(b);
r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
r = sexp_make_fixnum(sexp_bignum_sign(b) < 0 ? 1 : -1); r = sexp_make_fixnum(sexp_bignum_sign(b) < 0 ? 1 : -1);
break; break;
case SEXP_NUM_FLO_FLO: case SEXP_NUM_FLO_FLO:
f = sexp_flonum_value(a) - sexp_flonum_value(b); f = sexp_flonum_value(a);
r = sexp_make_fixnum(f > 0.0 ? 1 : f == 0.0 ? 0 : -1); g = sexp_flonum_value(b);
r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
break; break;
case SEXP_NUM_FLO_BIG: case SEXP_NUM_FLO_BIG:
f = sexp_flonum_value(a) - sexp_bignum_to_double(b); f = sexp_flonum_value(a);
r = sexp_make_fixnum(f > 0.0 ? 1 : f == 0.0 ? 0 : -1); g = sexp_bignum_to_double(b);
r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
break; break;
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));
break; break;
#if SEXP_USE_RATIOS #if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT: case SEXP_NUM_FLO_RAT:
f = sexp_flonum_value(a) - sexp_ratio_to_double(b); f = sexp_flonum_value(a);
r = sexp_make_fixnum(f > 0.0 ? 1 : f == 0.0 ? 0 : -1); 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:

24
tests/numeric-tests.scm
View file

@ -119,6 +119,30 @@
(-18446744078004518913 -18446744069414584321 79228162514264337597838917632 4294967296 -1)) (-18446744078004518913 -18446744069414584321 79228162514264337597838917632 4294967296 -1))
(sign-combinations (+ 1 (expt 2 64)) (expt 2 32))) (sign-combinations (+ 1 (expt 2 64)) (expt 2 32)))
(test #f (< +nan.0 +nan.0))
(test #f (<= +nan.0 +nan.0))
(test #f (= +nan.0 +nan.0))
(test #f (>= +nan.0 +nan.0))
(test #f (> +nan.0 +nan.0))
(test #f (< +inf.0 +inf.0))
(test #t (<= +inf.0 +inf.0))
(test #t (= +inf.0 +inf.0))
(test #t (>= +inf.0 +inf.0))
(test #f (> +inf.0 +inf.0))
(test #f (< -inf.0 -inf.0))
(test #t (<= -inf.0 -inf.0))
(test #t (= -inf.0 -inf.0))
(test #t (>= -inf.0 -inf.0))
(test #f (> -inf.0 -inf.0))
(test #t (< -inf.0 +inf.0))
(test #t (<= -inf.0 +inf.0))
(test #f (= -inf.0 +inf.0))
(test #f (>= -inf.0 +inf.0))
(test #f (> -inf.0 +inf.0))
(cond-expand (cond-expand
(ratios (ratios
(test #t (< 1/2 1.0)) (test #t (< 1/2 1.0))