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: Re: Introduction of fractions exposes uniform vector prototype bug Date: Sat, 20 Dec 2003 07:38:16 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87zndowks7.fsf@zip.com.au> References: NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1071870361 29934 80.91.224.253 (19 Dec 2003 21:46:01 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 19 Dec 2003 21:46:01 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Fri Dec 19 22:45:54 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 1AXSRW-0000x2-00 for ; Fri, 19 Dec 2003 22:45:54 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AXTN8-0003Rh-6R for guile-devel@m.gmane.org; Fri, 19 Dec 2003 17:45:26 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24) id 1AXTMC-00034q-9u for guile-devel@gnu.org; Fri, 19 Dec 2003 17:44:28 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24) id 1AXTJ0-0002Ed-RU for guile-devel@gnu.org; Fri, 19 Dec 2003 17:41:41 -0500 Original-Received: from [61.8.0.36] (helo=snoopy.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AXTI2-0001qQ-CE for guile-devel@gnu.org; Fri, 19 Dec 2003 17:40:10 -0500 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.6) with ESMTP id hBJLcfno012040 for ; Sat, 20 Dec 2003 08:38:41 +1100 Original-Received: from localhost (ppp130.dyn11.pacific.net.au [61.8.11.130]) by mongrel.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id hBJLcdxs000342 for ; Sat, 20 Dec 2003 08:38:39 +1100 Original-Received: from gg by localhost with local (Exim 3.35 #1 (Debian)) id 1AXSK8-0000cg-00; Sat, 20 Dec 2003 07:38:16 +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:3124 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:3124 --=-=-= Mikael Djurfeldt writes: > > I have no good suggestion for what to do about this, but one thing is > certain: We can't suggest people to use 1/3 as prototype for double > arrays (at least now without modifying scm_make_uve). I'd be pretty inclined to make it a special case, for compatibility. Asking people to change their code after they've followed something the manual explicitly said is never nice. Fractions apart from 1/3 could be left to indicate an array of fractions, if such a thing is added in the future. Perhaps (below), * unif.c (scm_make_uve): Recognise 1/3 for a dvect array of doubles, as specified in the manual. (scm_dimensions_to_uniform_array): Convert prototype 1/3 to an inexact, as required by scm_array_fill_x. (exactly_one_third): New variable. (scm_init_unif): Initialize it. * tests/unif.test: New file. Maybe array-fill! should use scm_num2dbl the same way array-set! does, instead of converting in scm_dimensions_to_uniform_array. I think it'd make a lot of sense for array-fill! and array-set! to accept the same operands. (Irrespective of what's done or not done to make_uve.) --=-=-= Content-Disposition: attachment; filename=unif.c.dvect.diff --- unif.c.~1.137.~ 2003-09-13 09:34:18.000000000 +1000 +++ unif.c 2003-12-19 15:22:10.000000000 +1000 @@ -1,4 +1,5 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003 Free Software + * Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -72,6 +73,7 @@ */ scm_t_bits scm_tc16_array; +static SCM exactly_one_third; /* return the size of an element in a uniform array or 0 if type not found. */ @@ -175,6 +177,15 @@ else type = scm_tc7_ivect; } + else if (SCM_FRACTIONP (prot)) + { + /* The manual says "1/3" is the prototype for a "double". This was + fine before fractions existed, 1/3 gave a flonum which didn't fit a + "float" (not without rounding). But now we need to check for this + value explicitly (to maintain upward compatibility). */ + if (scm_num_eq_p (exactly_one_third, prot)) + goto dvect; + } else if (SCM_SYMBOLP (prot) && (1 == SCM_SYMBOL_LENGTH (prot))) { char s; @@ -213,6 +224,7 @@ } else { + dvect: i = sizeof (double) * k; type = scm_tc7_dvect; } @@ -574,7 +586,11 @@ else if (SCM_SYMBOLP (prot)) scm_array_fill_x (answer, SCM_MAKINUM (0)); else - scm_array_fill_x (answer, prot); + { + if (SCM_FRACTIONP (prot) && scm_num_eq_p (exactly_one_third, prot)) + prot = scm_exact_to_inexact (prot); + scm_array_fill_x (answer, prot); + } return answer; } @@ -599,7 +615,11 @@ else if (SCM_SYMBOLP (prot)) scm_array_fill_x (ra, SCM_MAKINUM (0)); else - scm_array_fill_x (ra, prot); + { + if (SCM_FRACTIONP (prot) && scm_num_eq_p (exactly_one_third, prot)) + prot = scm_exact_to_inexact (prot); + scm_array_fill_x (ra, prot); + } if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) @@ -2585,6 +2605,8 @@ scm_set_smob_free (scm_tc16_array, array_free); scm_set_smob_print (scm_tc16_array, scm_raprin1); scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p); + exactly_one_third = scm_permanent_object (scm_make_ratio (SCM_MAKINUM (1), + SCM_MAKINUM (3))); scm_add_feature ("array"); #include "libguile/unif.x" } --=-=-= Content-Disposition: attachment; filename=unif.test ;;;; unif.test --- tests guile's uniform arrays -*- scheme -*- ;;;; ;;;; Copyright 2003 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 2.1 of the License, or (at your option) any later version. ;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (define-module (test-suite test-unif) #:use-module (test-suite lib) #:use-module (ice-9 documentation)) ;;; ;;; prototypes ;;; (with-test-prefix "prototypes" (with-test-prefix "make-uniform-vector" (pass-if "bool" (eq? #t (array-prototype (make-uniform-vector 1 #t)))) (pass-if "char" (char=? #\a (array-prototype (make-uniform-vector 1 #\a)))) (pass-if "byte" (char=? #\nul (array-prototype (make-uniform-vector 1 #\nul)))) (pass-if "short" (eq? 's (array-prototype (make-uniform-vector 1 's)))) (pass-if "ulong" (= 1 (array-prototype (make-uniform-vector 1 1)))) (pass-if "long" (= -1 (array-prototype (make-uniform-vector 1 -1)))) ;; FIXME: What's a good way to tell if long long is available? ;; (pass-if "long long" ;; (eq? 'l (array-prototype (make-uniform-vector 1 'l)))) (pass-if "float" (= 1.0 (array-prototype (make-uniform-vector 1 1.0)))) (with-test-prefix "double" (pass-if "no fill" (= 1/3 (array-prototype (make-uniform-vector 1 1/3)))) (pass-if "fill 1.0" (= 1/3 (array-prototype (make-uniform-vector 1 1/3 1.0))))) (pass-if "complex" (= 0+i (array-prototype (make-uniform-vector 1 0+i)))) (pass-if "scm" (eq? '() (array-prototype (make-uniform-vector 1 '()))))) (with-test-prefix "make-uniform-vector" (pass-if "bool" (eq? #t (array-prototype (make-uniform-array #t '(5 6))))) (pass-if "char" (char=? #\a (array-prototype (make-uniform-array #\a '(5 6))))) (pass-if "byte" (char=? #\nul (array-prototype (make-uniform-array #\nul '(5 6))))) (pass-if "short" (eq? 's (array-prototype (make-uniform-array 's '(5 6))))) (pass-if "ulong" (= 1 (array-prototype (make-uniform-array 1 '(5 6))))) (pass-if "long" (= -1 (array-prototype (make-uniform-array -1 '(5 6))))) ;; FIXME: What's a good way to tell if long long is available? ;; (pass-if "long long" ;; (eq? 'l (array-prototype (make-uniform-array 'l '(5 6))))) (pass-if "float" (= 1.0 (array-prototype (make-uniform-array 1.0 '(5 6))))) (pass-if "double" (= 1/3 (array-prototype (make-uniform-array 1/3 '(5 6))))) (pass-if "complex" (= 0+i (array-prototype (make-uniform-array 0+i '(5 6))))) (pass-if "scm" (eq? '() (array-prototype (make-uniform-array '( '(5 6)))))))) --=-=-= 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 --=-=-=--