Updating eqv? definition (from pre-bignum days) to latest R7RS definition.

This commit is contained in:
Alex Shinn 2012-10-17 20:53:56 +09:00
parent 4a86e133a9
commit 9aa03c0a09
4 changed files with 14 additions and 3 deletions

View file

@ -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

View file

@ -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

View file

@ -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)

2
sexp.c
View file

@ -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;