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: inexact->exact on nan and inf Date: Wed, 24 Sep 2003 09:50:54 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87llsfnjxd.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1064361558 16329 80.91.224.253 (23 Sep 2003 23:59:18 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 23 Sep 2003 23:59:18 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Sep 24 01:59:15 2003 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 1A1x3r-0006BE-00 for ; Wed, 24 Sep 2003 01:59:15 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.22) id 1A1x1N-0001cf-Pp for guile-devel@m.gmane.org; Tue, 23 Sep 2003 19:56:41 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.22) id 1A1x06-0001AA-IV for guile-devel@gnu.org; Tue, 23 Sep 2003 19:55:22 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.22) id 1A1wwF-00008R-9B for guile-devel@gnu.org; Tue, 23 Sep 2003 19:51:24 -0400 Original-Received: from [61.8.0.36] (helo=snoopy.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.22) id 1A1wvv-0008Vj-AZ for guile-devel@gnu.org; Tue, 23 Sep 2003 19:51:03 -0400 Original-Received: from mongrel.pacific.net.au (mongrel.pacific.net.au [61.8.0.107]) by snoopy.pacific.net.au (8.12.3/8.12.3/Debian-6.4) with ESMTP id h8NNp0G4012943 for ; Wed, 24 Sep 2003 09:51:00 +1000 Original-Received: from localhost (ppp28.dyn228.pacific.net.au [203.143.228.28]) by mongrel.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id h8NNmRXY023945 for ; Wed, 24 Sep 2003 09:48:28 +1000 Original-Received: from gg by localhost with local (Exim 3.35 #1 (Debian)) id 1A1wvm-0000KN-00; Wed, 24 Sep 2003 09:50:54 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never User-Agent: Gnus/5.1003 (Gnus v5.10.3) Emacs/21.3 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.2 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:2823 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:2823 --=-=-= * numbers.c (scm_inexact_to_exact): Don't depend on what double->long cast gives for values bigger than a long, or for nan or inf. * tests/numbers.test (inexact->exact): New tests. This is merely a defensive proposal, it actually comes out ok on my i386 debian already, since casting double->long gives 0x80000000 or 0x7FFFFFFF for values out of range, which of course don't pass SCM_FIXABLE. But it doesn't seem wise to assume such values. New code, for ease of contemplation, /* The values SCM_MOST_POSITIVE_FIXNUM+1 and SCM_MOST_NEGATIVE_FIXNUM are both powers of 2, so there's no rounding when making "double" values from them. If plain SCM_MOST_POSITIVE_FIXNUM was used it could get rounded on a 64-bit machine, hence the "+1". The use of floor to force to an integer value ensures we don't depend on how a double->long cast will round or how mpz_set_d will round. For reference, double->long probably follows the hardware rounding mode, whereas mpz_set_d truncates towards zero. */ double u = SCM_REAL_VALUE (z); if (xisinf (u) || xisnan (u)) scm_num_overflow (s_scm_inexact_to_exact); u = floor (u + 0.5); if (u < (double) (SCM_MOST_POSITIVE_FIXNUM+1) && u >= (double) SCM_MOST_NEGATIVE_FIXNUM) return SCM_MAKINUM ((long) u); else return scm_i_dbl2big (u); --=-=-= Content-Disposition: attachment; filename=numbers.c.inexact-nan.diff --- numbers.c.~1.200.~ 1970-01-01 10:00:01.000000000 +1000 +++ numbers.c 2003-09-23 16:33:30.000000000 +1000 @@ -4337,14 +4337,25 @@ return z; else if (SCM_REALP (z)) { - double u = floor (SCM_REAL_VALUE (z) + 0.5); - long lu = (long) u; - if (SCM_FIXABLE (lu)) - return SCM_MAKINUM (lu); - else if (!xisinf (u) && !xisnan (u)) - return scm_i_dbl2big (u); - else + /* The values SCM_MOST_POSITIVE_FIXNUM+1 and SCM_MOST_NEGATIVE_FIXNUM + are both powers of 2, so there's no rounding when making "double" + values from them. If plain SCM_MOST_POSITIVE_FIXNUM was used it + could get rounded on a 64-bit machine, hence the "+1". + + The use of floor to force to an integer value ensures we don't + depend on how a double->long cast will round or how mpz_set_d will + round. For reference, double->long probably follows the hardware + rounding mode, but mpz_set_d truncates towards zero. */ + + double u = SCM_REAL_VALUE (z); + if (xisinf (u) || xisnan (u)) scm_num_overflow (s_scm_inexact_to_exact); + u = floor (u + 0.5); + if (u < (double) (SCM_MOST_POSITIVE_FIXNUM+1) + && u >= (double) SCM_MOST_NEGATIVE_FIXNUM) + return SCM_MAKINUM ((long) u); + else + return scm_i_dbl2big (u); } else SCM_WRONG_TYPE_ARG (1, z); --=-=-= Content-Disposition: attachment; filename=numbers.test.inexact.diff --- numbers.test.~1.32.~ 1970-01-01 10:00:01.000000000 +1000 +++ numbers.test 2003-09-22 16:34:30.000000000 +1000 @@ -2015,6 +2015,24 @@ ;;; inexact->exact ;;; +(with-test-prefix "inexact->exact" + + (pass-if-exception exception:numerical-overflow "+inf" + (inexact->exact +.inf)) + + (pass-if-exception exception:numerical-overflow "-inf" + (inexact->exact -.inf)) + + (pass-if-exception exception:numerical-overflow "nan" + (inexact->exact +.nan)) + + (with-test-prefix "2.0**i to exact and back" + (do ((i 0 (1+ i)) + (n 1.0 (* 2.0 n))) + ((> i 100)) + (pass-if (list i n) + (= n (inexact->exact (exact->inexact n))))))) + ;;; ;;; integer-length ;;; --=-=-= 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 --=-=-=--