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: min,max frac exact compare Date: Thu, 15 Apr 2004 10:43:05 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87llkyhy06.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1081990300 16964 80.91.224.253 (15 Apr 2004 00:51:40 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Thu, 15 Apr 2004 00:51:40 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Thu Apr 15 02:51:11 2004 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1BDv5y-0005GY-00 for ; Thu, 15 Apr 2004 02:51:10 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1BDv5d-0004fS-Up for guile-devel@m.gmane.org; Wed, 14 Apr 2004 20:50:49 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1BDv4q-0004ES-HF for guile-devel@gnu.org; Wed, 14 Apr 2004 20:50:00 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1BDv0d-0001Om-8T for guile-devel@gnu.org; Wed, 14 Apr 2004 20:46:10 -0400 Original-Received: from [61.8.0.85] (helo=mailout2.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.30) id 1BDuyU-00088Q-2n for guile-devel@gnu.org; Wed, 14 Apr 2004 20:43:26 -0400 Original-Received: from mailproxy1.pacific.net.au (mailproxy1.pacific.net.au [61.8.0.86]) by mailout2.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id i3F0hE5v017261 for ; Thu, 15 Apr 2004 10:43:14 +1000 Original-Received: from localhost (ppp270A.dyn.pacific.net.au [61.8.39.10]) by mailproxy1.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id i3F0hCGP028210 for ; Thu, 15 Apr 2004 10:43:13 +1000 Original-Received: from gg by localhost with local (Exim 3.36 #1 (Debian)) id 1BDuyA-0000RF-00; Thu, 15 Apr 2004 10:43:06 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never User-Agent: Gnus/5.110002 (No Gnus v0.2) Emacs/21.3 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:3600 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:3600 --=-=-= Fractions with min and max previously mentioned. * numbers.c (scm_max, scm_min): For inum/frac, frac/inum, big/frac, frac/big and frac/frac, use scm_less_p for exact comparison. * tests/numbers.test (max, min): Exercise some inum/frac, frac/inum, big/frac, frac/big and frac/frac cases. --=-=-= Content-Disposition: inline; filename=numbers.c.min-max-frac.diff --- numbers.c.~1.232.~ 2004-04-06 10:14:09.000000000 +1000 +++ numbers.c 2004-04-13 15:21:21.000000000 +1000 @@ -3546,8 +3546,8 @@ } else if (SCM_FRACTIONP (y)) { - double z = xx; - return (z > scm_i_fraction2double (y)) ? x : y; + use_less: + return (SCM_FALSEP (scm_less_p (x, y)) ? x : y); } else SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); @@ -3577,11 +3577,7 @@ } else if (SCM_FRACTIONP (y)) { - double yy = scm_i_fraction2double (y); - int cmp; - cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), yy); - scm_remember_upto_here_1 (x); - return (cmp > 0) ? x : y; + goto use_less; } else SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); @@ -3621,16 +3617,11 @@ { if (SCM_INUMP (y)) { - double z = SCM_INUM (y); - return (scm_i_fraction2double (x) < z) ? y : x; + goto use_less; } else if (SCM_BIGP (y)) { - double xx = scm_i_fraction2double (x); - int cmp; - cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), xx); - scm_remember_upto_here_1 (y); - return (cmp < 0) ? x : y; + goto use_less; } else if (SCM_REALP (y)) { @@ -3639,9 +3630,7 @@ } else if (SCM_FRACTIONP (y)) { - double yy = scm_i_fraction2double (y); - double xx = scm_i_fraction2double (x); - return (xx < yy) ? y : x; + goto use_less; } else SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); @@ -3689,8 +3678,8 @@ } else if (SCM_FRACTIONP (y)) { - double z = xx; - return (z < scm_i_fraction2double (y)) ? x : y; + use_less: + return (SCM_FALSEP (scm_less_p (x, y)) ? y : x); } else SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); @@ -3720,11 +3709,7 @@ } else if (SCM_FRACTIONP (y)) { - double yy = scm_i_fraction2double (y); - int cmp; - cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), yy); - scm_remember_upto_here_1 (x); - return (cmp > 0) ? y : x; + goto use_less; } else SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); @@ -3764,16 +3749,11 @@ { if (SCM_INUMP (y)) { - double z = SCM_INUM (y); - return (scm_i_fraction2double (x) < z) ? x : y; + goto use_less; } else if (SCM_BIGP (y)) { - double xx = scm_i_fraction2double (x); - int cmp; - cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), xx); - scm_remember_upto_here_1 (y); - return (cmp < 0) ? y : x; + goto use_less; } else if (SCM_REALP (y)) { @@ -3782,9 +3762,7 @@ } else if (SCM_FRACTIONP (y)) { - double yy = scm_i_fraction2double (y); - double xx = scm_i_fraction2double (x); - return (xx < yy) ? x : y; + goto use_less; } else SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); --=-=-= Content-Disposition: inline; filename=numbers.test.min-max-frac.diff --- numbers.test.~1.45.~ 2004-03-27 19:11:43.000000000 +1000 +++ numbers.test 2004-04-13 15:29:50.000000000 +1000 @@ -1952,12 +1952,28 @@ (big*4 (* fixnum-max 4)) (big*5 (* fixnum-max 5))) + (with-test-prefix "inum / frac" + (pass-if (= 3 (max 3 5/2))) + (pass-if (= 5/2 (max 2 5/2)))) + + (with-test-prefix "frac / inum" + (pass-if (= 3 (max 5/2 3))) + (pass-if (= 5/2 (max 5/2 2)))) + (with-test-prefix "inum / real" (pass-if (nan? (max 123 +nan.0)))) (with-test-prefix "real / inum" (pass-if (nan? (max +nan.0 123)))) + (with-test-prefix "big / frac" + (pass-if (= big*2 (max big*2 5/2))) + (pass-if (= 5/2 (max (- big*2) 5/2)))) + + (with-test-prefix "frac / big" + (pass-if (= big*2 (max 5/2 big*2))) + (pass-if (= 5/2 (max 5/2 (- big*2))))) + (with-test-prefix "big / real" (pass-if (nan? (max big*5 +nan.0))) (pass-if (= big*5 (max big*5 -inf.0))) @@ -1974,6 +1990,12 @@ (pass-if (inexact? (max 1.0 big*5))) (pass-if (= (exact->inexact big*5) (max 1.0 big*5)))) + (with-test-prefix "frac / frac" + (pass-if (= 2/3 (max 1/2 2/3))) + (pass-if (= 2/3 (max 2/3 1/2))) + (pass-if (= -1/2 (max -1/2 -2/3))) + (pass-if (= -1/2 (max -2/3 -1/2)))) + (with-test-prefix "real / real" (pass-if (nan? (max 123.0 +nan.0))) (pass-if (nan? (max +nan.0 123.0))) @@ -2057,12 +2079,28 @@ (pass-if (= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1)))) + (with-test-prefix "inum / frac" + (pass-if (= 5/2 (min 3 5/2))) + (pass-if (= 2 (min 2 5/2)))) + + (with-test-prefix "frac / inum" + (pass-if (= 5/2 (min 5/2 3))) + (pass-if (= 2 (min 5/2 2)))) + (with-test-prefix "inum / real" (pass-if (nan? (min 123 +nan.0)))) (with-test-prefix "real / inum" (pass-if (nan? (min +nan.0 123)))) + (with-test-prefix "big / frac" + (pass-if (= 5/2 (min big*2 5/2))) + (pass-if (= (- big*2) (min (- big*2) 5/2)))) + + (with-test-prefix "frac / big" + (pass-if (= 5/2 (min 5/2 big*2))) + (pass-if (= (- big*2) (min 5/2 (- big*2))))) + (with-test-prefix "big / real" (pass-if (nan? (min big*5 +nan.0))) (pass-if (= big*5 (min big*5 +inf.0))) @@ -2079,6 +2117,12 @@ (pass-if (inexact? (min 1.0 (- big*5)))) (pass-if (= (exact->inexact (- big*5)) (min 1.0 (- big*5))))) + (with-test-prefix "frac / frac" + (pass-if (= 1/2 (min 1/2 2/3))) + (pass-if (= 1/2 (min 2/3 1/2))) + (pass-if (= -2/3 (min -1/2 -2/3))) + (pass-if (= -2/3 (min -2/3 -1/2)))) + (with-test-prefix "real / real" (pass-if (nan? (min 123.0 +nan.0))) (pass-if (nan? (min +nan.0 123.0))) --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel --=-=-=--