From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Kevin Ryde Newsgroups: gmane.lisp.guile.devel Subject: mpz_cmp_d and NaNs in = and < Date: Tue, 06 May 2003 09:24:35 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87isspt1sc.fsf@zip.com.au> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1052177498 27668 80.91.224.249 (5 May 2003 23:31:38 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 5 May 2003 23:31:38 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue May 06 01:31:36 2003 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 19CpPh-00078I-00 for ; Tue, 06 May 2003 01:30:29 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 19CpNs-0002To-01 for guile-devel@m.gmane.org; Mon, 05 May 2003 19:28:36 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10.13) id 19CpMn-000281-00 for guile-devel@gnu.org; Mon, 05 May 2003 19:27:29 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10.13) id 19CpMD-0000nS-00 for guile-devel@gnu.org; Mon, 05 May 2003 19:27:03 -0400 Original-Received: from snoopy.pacific.net.au ([61.8.0.36]) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 19CpKI-0007b1-00 for guile-devel@gnu.org; Mon, 05 May 2003 19:24:54 -0400 Original-Received: from sunny.pacific.net.au (sunny.pacific.net.au [203.2.228.40]) h45NOlJS006919 for ; Tue, 6 May 2003 09:24:47 +1000 Original-Received: from wisma.pacific.net.au (wisma.pacific.net.au [210.23.129.72]) by sunny.pacific.net.au with ESMTP id h45NOlQg028518 for ; Tue, 6 May 2003 09:24:47 +1000 (EST) Original-Received: from localhost (ppp27.dyn228.pacific.net.au [203.143.228.27]) by wisma.pacific.net.au (8.12.9/8.12.9) with ESMTP id h45NOiYZ001128 for ; Tue, 6 May 2003 09:24:45 +1000 (EST) Original-Received: from gg by localhost with local (Exim 3.35 #1 (Debian)) id 19CpK0-0001HF-00; Tue, 06 May 2003 09:24:36 +1000 Original-To: guile-devel@gnu.org User-Agent: Gnus/5.090019 (Oort Gnus v0.19) Emacs/21.2 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1b5 Precedence: list List-Id: Developers list for Guile, the GNU extensibility library List-Help: List-Post: List-Subscribe: , List-Archive: List-Unsubscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:2269 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:2269 --=-=-= A concrete proposal for NaNs in = and <. As mentioned previously, mpz_cmp_d doesn't accept them. * numbers.c (scm_num_eq_p, scm_less_p): Don't pass NaN to mpz_cmp_d. * tests/numbers.test (=, <): Add tests involving NaNs. Are the comments correct about SCM_COMPLEXP numbers never having a zero imaginary part? I suspect this means the mpz_cmp_d's in the complex/bignum cases are not reached. In fact perhaps any comparison (= complex non-complex) would be #f without any testing. --=-=-= Content-Disposition: attachment; filename=numbers.c.nan.diff --- numbers.c.~1.181.~ 2003-05-04 09:09:49.000000000 +1000 +++ numbers.c 2003-05-05 12:04:05.000000000 +1000 @@ -2520,12 +2520,15 @@ scm_remember_upto_here_2 (x, y); return SCM_BOOL (0 == cmp); } else if (SCM_REALP (y)) { - int cmp = mpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (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)); 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)); scm_remember_upto_here_1 (x); return SCM_BOOL (0 == cmp); @@ -2536,7 +2539,9 @@ if (SCM_INUMP (y)) { return SCM_BOOL (SCM_REAL_VALUE (x) == (double) SCM_INUM (y)); } else if (SCM_BIGP (y)) { - int cmp = mpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x)); + 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)); scm_remember_upto_here_1 (y); return SCM_BOOL (0 == cmp); } else if (SCM_REALP (y)) { @@ -2554,6 +2559,7 @@ } else if (SCM_BIGP (y)) { 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)); scm_remember_upto_here_1 (y); return SCM_BOOL (0 == cmp); @@ -2603,7 +2609,9 @@ scm_remember_upto_here_2 (x, y); return SCM_BOOL (cmp < 0); } else if (SCM_REALP (y)) { - int cmp = mpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (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)); scm_remember_upto_here_1 (x); return SCM_BOOL (cmp < 0); } else { @@ -2613,7 +2621,9 @@ if (SCM_INUMP (y)) { return SCM_BOOL (SCM_REAL_VALUE (x) < (double) SCM_INUM (y)); } else if (SCM_BIGP (y)) { - int cmp = mpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x)); + 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)); scm_remember_upto_here_1 (y); return SCM_BOOL (cmp > 0); } else if (SCM_REALP (y)) { --=-=-= Content-Disposition: attachment; filename=numbers.test.nan.diff Index: numbers.test =================================================================== RCS file: /cvsroot/guile/guile/guile-core/test-suite/tests/numbers.test,v retrieving revision 1.19 diff -u -u -r1.19 numbers.test --- numbers.test 5 May 2003 23:04:02 -0000 1.19 +++ numbers.test 5 May 2003 23:22:53 -0000 @@ -1157,7 +1157,30 @@ (expect-fail (= (+ 1 fixnum-max) fixnum-max)) (expect-fail (= fixnum-min (- fixnum-min 1))) (expect-fail (= (- fixnum-min 1) fixnum-min)) - (expect-fail (= (+ fixnum-max 1) (- fixnum-min 1)))) + (expect-fail (= (+ fixnum-max 1) (- fixnum-min 1))) + + (pass-if (not (= +nan.0 +nan.0))) + (pass-if (not (= 0 +nan.0))) + (pass-if (not (= +nan.0 0))) + (pass-if (not (= 1 +nan.0))) + (pass-if (not (= +nan.0 1))) + (pass-if (not (= -1 +nan.0))) + (pass-if (not (= +nan.0 -1))) + + (pass-if (not (= (ash 1 256) +nan.0))) + (pass-if (not (= +nan.0 (ash 1 256)))) + (pass-if (not (= (- (ash 1 256)) +nan.0))) + (pass-if (not (= +nan.0 (- (ash 1 256))))) + + (pass-if (not (= (ash 1 8192) +nan.0))) + (pass-if (not (= +nan.0 (ash 1 8192)))) + (pass-if (not (= (- (ash 1 8192)) +nan.0))) + (pass-if (not (= +nan.0 (- (ash 1 8192))))) + + ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make + ;; sure we've avoided that + (pass-if (not (= (ash 3 1023) +nan.0))) + (pass-if (not (= +nan.0 (ash 3 1023))))) ;;; ;;; < @@ -1486,7 +1509,34 @@ (< (- fixnum-min 1) fixnum-min)) (pass-if "n = fixnum-min - 1" - (not (< (- fixnum-min 1) (- fixnum-min 1)))))) + (not (< (- fixnum-min 1) (- fixnum-min 1))))) + + (pass-if (not (< +nan.0 +nan.0))) + (pass-if (not (< 0 +nan.0))) + (pass-if (not (< +nan.0 0))) + (pass-if (not (< 1 +nan.0))) + (pass-if (not (< +nan.0 1))) + (pass-if (not (< -1 +nan.0))) + (pass-if (not (< +nan.0 -1))) + + (pass-if (not (< (ash 1 256) +nan.0))) + (pass-if (not (< +nan.0 (ash 1 256)))) + (pass-if (not (< (- (ash 1 256)) +nan.0))) + (pass-if (not (< +nan.0 (- (ash 1 256))))) + + (pass-if (not (< (ash 1 8192) +nan.0))) + (pass-if (not (< +nan.0 (ash 1 8192)))) + (pass-if (not (< (- (ash 1 8192)) +nan.0))) + (pass-if (not (< +nan.0 (- (ash 1 8192))))) + + ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make + ;; sure we've avoided that + (pass-if (not (< (ash 3 1023) +nan.0))) + (pass-if (not (< (1+ (ash 3 1023)) +nan.0))) + (pass-if (not (< (1- (ash 3 1023)) +nan.0))) + (pass-if (not (< +nan.0 (ash 3 1023)))) + (pass-if (not (< +nan.0 (1+ (ash 3 1023))))) + (pass-if (not (< +nan.0 (1- (ash 3 1023)))))) ;;; ;;; > --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel --=-=-=--