diff --git a/include/chibi/features.h b/include/chibi/features.h index 9308d4c6..5354c357 100644 --- a/include/chibi/features.h +++ b/include/chibi/features.h @@ -447,6 +447,10 @@ #define SEXP_USE_IMMEDIATE_FLONUMS 0 #endif +#ifndef SEXP_USE_IEEE_EQV +#define SEXP_USE_IEEE_EQV SEXP_USE_FLONUMS +#endif + #ifndef SEXP_USE_PLACEHOLDER_DIGITS #define SEXP_USE_PLACEHOLDER_DIGITS 0 #endif diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 1aec5569..905fe358 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -819,6 +819,13 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x); #define sexp_infp(x) (sexp_flonump(x) && isinf(sexp_flonum_value(x))) #define sexp_nanp(x) (sexp_flonump(x) && isnan(sexp_flonum_value(x))) +#if SEXP_USE_IEEE_EQV +#define sexp_flonum_bits(x) (*(long*)(&(sexp_flonum_value(x)))) +#define sexp_flonum_eqv(x, y) (sexp_flonum_bits(x) == sexp_flonum_bits(y)) +#else +#define sexp_flonum_eqv(x, y) (sexp_flonum_value(x) == sexp_flonum_value(y)) +#endif + /*************************** field accessors **************************/ #if SEXP_USE_SAFE_ACCESSORS diff --git a/lib/init-7.scm b/lib/init-7.scm index 87e6a474..21b71212 100644 --- a/lib/init-7.scm +++ b/lib/init-7.scm @@ -429,8 +429,6 @@ ;; list utils -(define (eqv? a b) (if (eq? a b) #t (and (flonum? a) (flonum? b) (= a b)))) - (define (member obj ls . o) (let ((eq (if (pair? o) (car o) equal?))) (let lp ((ls ls)) @@ -1018,6 +1016,8 @@ (define (rational? x) (and (real? x) (= x x) (not (= x (+ x (if (positive? x) 1 -1)))))) +(define (eqv? a b) (if (eq? a b) #t (and (number? a) (equal? a b)))) + (define (exact-integer-sqrt x) (let ((res (sqrt x))) (if (exact? res) diff --git a/sexp.c b/sexp.c index 20b5420f..18a8d6d7 100644 --- a/sexp.c +++ b/sexp.c @@ -799,7 +799,7 @@ sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp #endif #if SEXP_USE_FLONUMS && ! SEXP_USE_IMMEDIATE_FLONUMS if (sexp_pointer_tag(a) == SEXP_FLONUM) - return (sexp_flonum_value(a) == sexp_flonum_value(b)) ? bound : SEXP_FALSE; + return sexp_flonum_eqv(a, b) ? bound : SEXP_FALSE; #endif if (sexp_unbox_fixnum(bound) < 0) /* exceeded limit */ return bound;