* mpz_cmp_d and infs
@ 2003-05-10 4:00 Kevin Ryde
0 siblings, 0 replies; only message in thread
From: Kevin Ryde @ 2003-05-10 4:00 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 312 bytes --]
A concrete proposal for handling infs with mpz_cmp_d, as previously
mentioned.
* numbers.c (xmpz_cmp_d): New macro, handling infs if gmp doesn't.
(scm_num_eq_p, scm_less_p, scm_max, scm_min): Use it.
* tests/numbers.test (=, <, max, min): Add tests of bignum/inf
combinations.
[-- Attachment #2: numbers.c.cmp_d-inf.diff --]
[-- Type: text/plain, Size: 4279 bytes --]
--- numbers.c.~1.187.~ 2003-05-10 10:14:23.000000000 +1000
+++ numbers.c 2003-05-10 12:12:55.000000000 +1000
@@ -105,6 +105,17 @@
#endif
#endif
+
+/* mpz_cmp_d only recognises infinities in gmp 4.2 and up.
+ For prior versions use an explicit check here. */
+#if __GNU_MP_VERSION < 4 \
+ || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2)
+#define xmpz_cmp_d(z, d) \
+ (xisinf (d) ? (d < 0.0 ? 1 : -1) : mpz_cmp_d (z, d))
+#else
+#define xmpz_cmp_d(z, d) mpz_cmp_d (z, d)
+#endif
+
\f
static SCM abs_most_negative_fixnum;
@@ -2531,14 +2542,14 @@
} else if (SCM_REALP (y)) {
int cmp;
if (xisnan (SCM_REAL_VALUE (y))) return SCM_BOOL_F;
- cmp = mpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
+ cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
scm_remember_upto_here_1 (x);
return SCM_BOOL (0 == cmp);
} else if (SCM_COMPLEXP (y)) {
int cmp;
if (0.0 != SCM_COMPLEX_IMAG (y)) return SCM_BOOL_F;
if (xisnan (SCM_COMPLEX_REAL (y))) return SCM_BOOL_F;
- cmp = mpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_COMPLEX_REAL (y));
+ cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_COMPLEX_REAL (y));
scm_remember_upto_here_1 (x);
return SCM_BOOL (0 == cmp);
} else {
@@ -2550,7 +2561,7 @@
} else if (SCM_BIGP (y)) {
int cmp;
if (xisnan (SCM_REAL_VALUE (x))) return SCM_BOOL_F;
- cmp = mpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
+ cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
scm_remember_upto_here_1 (y);
return SCM_BOOL (0 == cmp);
} else if (SCM_REALP (y)) {
@@ -2569,7 +2580,7 @@
int cmp;
if (0.0 != SCM_COMPLEX_IMAG (x)) return SCM_BOOL_F;
if (xisnan (SCM_COMPLEX_REAL (x))) return SCM_BOOL_F;
- cmp = mpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_COMPLEX_REAL (x));
+ cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_COMPLEX_REAL (x));
scm_remember_upto_here_1 (y);
return SCM_BOOL (0 == cmp);
} else if (SCM_REALP (y)) {
@@ -2620,7 +2631,7 @@
} else if (SCM_REALP (y)) {
int cmp;
if (xisnan (SCM_REAL_VALUE (y))) return SCM_BOOL_F;
- cmp = mpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
+ cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
scm_remember_upto_here_1 (x);
return SCM_BOOL (cmp < 0);
} else {
@@ -2632,7 +2643,7 @@
} else if (SCM_BIGP (y)) {
int cmp;
if (xisnan (SCM_REAL_VALUE (x))) return SCM_BOOL_F;
- cmp = mpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
+ cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
scm_remember_upto_here_1 (y);
return SCM_BOOL (cmp > 0);
} else if (SCM_REALP (y)) {
@@ -2809,7 +2820,7 @@
scm_remember_upto_here_2 (x, y);
return (cmp > 0) ? x : y;
} else if (SCM_REALP (y)) {
- int cmp = mpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
+ int cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
scm_remember_upto_here_1 (x);
return (cmp > 0) ? x : y;
} else {
@@ -2820,7 +2831,7 @@
double z = SCM_INUM (y);
return (SCM_REAL_VALUE (x) < z) ? scm_make_real (z) : x;
} else if (SCM_BIGP (y)) {
- int cmp = mpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
+ int cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
scm_remember_upto_here_1 (y);
return (cmp < 0) ? x : y;
} else if (SCM_REALP (y)) {
@@ -2875,7 +2886,7 @@
scm_remember_upto_here_2 (x, y);
return (cmp > 0) ? y : x;
} else if (SCM_REALP (y)) {
- int cmp = mpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
+ int cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y));
scm_remember_upto_here_1 (x);
return (cmp > 0) ? y : x;
} else {
@@ -2886,7 +2897,7 @@
double z = SCM_INUM (y);
return (SCM_REAL_VALUE (x) <= z) ? x : scm_make_real (z);
} else if (SCM_BIGP (y)) {
- int cmp = mpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
+ int cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x));
scm_remember_upto_here_1 (y);
return (cmp < 0) ? y : x;
} else if (SCM_REALP (y)) {
[-- Attachment #3: numbers.test.cmp_d-inf.diff --]
[-- Type: text/plain, Size: 3797 bytes --]
--- numbers.test.~1.22.~ 2003-05-10 10:13:58.000000000 +1000
+++ numbers.test 2003-05-10 13:01:51.000000000 +1000
@@ -1164,6 +1164,18 @@
(expect-fail (= (- fixnum-min 1) fixnum-min))
(expect-fail (= (+ fixnum-max 1) (- fixnum-min 1)))
+ (pass-if (not (= (ash 1 256) +inf.0)))
+ (pass-if (not (= +inf.0 (ash 1 256))))
+ (pass-if (not (= (ash 1 256) -inf.0)))
+ (pass-if (not (= -inf.0 (ash 1 256))))
+
+ ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
+ ;; sure we've avoided that
+ (pass-if (not (= (ash 1 1024) +inf.0)))
+ (pass-if (not (= +inf.0 (ash 1 1024))))
+ (pass-if (not (= (- (ash 1 1024)) -inf.0)))
+ (pass-if (not (= -inf.0 (- (ash 1 1024)))))
+
(pass-if (not (= +nan.0 +nan.0)))
(pass-if (not (= 0 +nan.0)))
(pass-if (not (= +nan.0 0)))
@@ -1516,6 +1528,26 @@
(pass-if "n = fixnum-min - 1"
(not (< (- fixnum-min 1) (- fixnum-min 1)))))
+ (pass-if (< (ash 1 256) +inf.0))
+ (pass-if (not (< +inf.0 (ash 1 256))))
+ (pass-if (not (< (ash 1 256) -inf.0)))
+ (pass-if (< -inf.0 (ash 1 256)))
+
+ ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
+ ;; sure we've avoided that
+ (pass-if (< (1- (ash 1 1024)) +inf.0))
+ (pass-if (< (ash 1 1024) +inf.0))
+ (pass-if (< (1+ (ash 1 1024)) +inf.0))
+ (pass-if (not (< +inf.0 (1- (ash 1 1024)))))
+ (pass-if (not (< +inf.0 (ash 1 1024))))
+ (pass-if (not (< +inf.0 (1+ (ash 1 1024)))))
+ (pass-if (< -inf.0 (- (1- (ash 1 1024)))))
+ (pass-if (< -inf.0 (- (ash 1 1024))))
+ (pass-if (< -inf.0 (- (1+ (ash 1 1024)))))
+ (pass-if (not (< (- (1- (ash 1 1024))) -inf.0)))
+ (pass-if (not (< (- (ash 1 1024)) -inf.0)))
+ (pass-if (not (< (- (1+ (ash 1 1024))) -inf.0)))
+
(pass-if (not (< +nan.0 +nan.0)))
(pass-if (not (< 0 +nan.0)))
(pass-if (not (< +nan.0 0)))
@@ -1613,6 +1645,35 @@
;;; max
;;;
+(with-test-prefix "max"
+ (let ((big*2 (* fixnum-max 2))
+ (big*3 (* fixnum-max 3))
+ (big*4 (* fixnum-max 4))
+ (big*5 (* fixnum-max 5)))
+
+ (pass-if (= +inf.0 (max big*5 +inf.0)))
+ (pass-if (= +inf.0 (max +inf.0 big*5)))
+ (pass-if (= big*5 (max big*5 -inf.0)))
+ (pass-if (= big*5 (max -inf.0 big*5))))
+
+ ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
+ ;; sure we've avoided that
+ (for-each (lambda (b)
+ (pass-if (list b +inf.0)
+ (= +inf.0 (max b +inf.0)))
+ (pass-if (list +inf.0 b)
+ (= +inf.0 (max b +inf.0)))
+ (pass-if (list b -inf.0)
+ (= b (max b -inf.0)))
+ (pass-if (list -inf.0 b)
+ (= b (max b -inf.0))))
+ (list (1- (ash 1 1024))
+ (ash 1 1024)
+ (1+ (ash 1 1024))
+ (- (1- (ash 1 1024)))
+ (- (ash 1 1024))
+ (- (1+ (ash 1 1024))))))
+
;;;
;;; min
;;;
@@ -1640,8 +1701,31 @@
(pass-if
(= (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
(pass-if
- (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))))
+ (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
+ (pass-if (= big*5 (min big*5 +inf.0)))
+ (pass-if (= big*5 (min +inf.0 big*5)))
+ (pass-if (= -inf.0 (min big*5 -inf.0)))
+ (pass-if (= -inf.0 (min -inf.0 big*5))))
+
+ ;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
+ ;; sure we've avoided that
+ (for-each (lambda (b)
+ (pass-if (list b +inf.0)
+ (= b (min b +inf.0)))
+ (pass-if (list +inf.0 b)
+ (= b (min b +inf.0)))
+ (pass-if (list b -inf.0)
+ (= -inf.0 (min b -inf.0)))
+ (pass-if (list -inf.0 b)
+ (= -inf.0 (min b -inf.0))))
+ (list (1- (ash 1 1024))
+ (ash 1 1024)
+ (1+ (ash 1 1024))
+ (- (1- (ash 1 1024)))
+ (- (ash 1 1024))
+ (- (1+ (ash 1 1024))))))
+
;;;
;;; +
;;;
[-- Attachment #4: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2003-05-10 4:00 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-05-10 4:00 mpz_cmp_d and infs Kevin Ryde
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).