From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: daniel.llorens@bluewin.ch Newsgroups: gmane.lisp.guile.devel Subject: [PATCH 4/6] Support non-zero lower bounds in array-slice-for-each Date: Tue, 21 Feb 2017 12:59:33 +0100 Message-ID: <20170221115935.32734-5-daniel.llorens@bluewin.ch> References: <20170221115935.32734-1-daniel.llorens@bluewin.ch> NNTP-Posting-Host: blaine.gmane.org X-Trace: blaine.gmane.org 1487681722 1773 195.159.176.226 (21 Feb 2017 12:55:22 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 21 Feb 2017 12:55:22 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Feb 21 13:55:17 2017 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cg9yL-0007f3-EL for guile-devel@m.gmane.org; Tue, 21 Feb 2017 13:55:13 +0100 Original-Received: from localhost ([::1]:44284 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cg9yL-0000ra-Sd for guile-devel@m.gmane.org; Tue, 21 Feb 2017 07:55:13 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39228) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cg96e-0000o4-41 for guile-devel@gnu.org; Tue, 21 Feb 2017 06:59:45 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cg96b-0005w7-4m for guile-devel@gnu.org; Tue, 21 Feb 2017 06:59:44 -0500 Original-Received: from vimdzmsp-sfwd05.bluewin.ch ([195.186.120.133]:44458 helo=smtpauths.lb.bluewin.ch) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cg96a-0005vi-QK for guile-devel@gnu.org; Tue, 21 Feb 2017 06:59:41 -0500 Original-Received: from 4box.hq.corp.viasat.com ([213.193.80.99]) by vimdzmsp-sfwd05.bluewin.ch Swisscom AG with SMTP id g96XcxdFruCSsg96YcaSVY; Tue, 21 Feb 2017 12:59:38 +0100 X-Bluewin-Spam-Analysis: v=2.1 cv=fcANsxkF c=1 sm=1 tr=0 a=DzaHVtLsrNCQ5PccsnG91A==:117 a=DzaHVtLsrNCQ5PccsnG91A==:17 a=L9H7d07YOLsA:10 a=9cW_t1CCXrUA:10 a=s5jvgZ67dGcA:10 a=4c6QksrK3gqF8dtoT9kA:9 X-Bluewin-Spam-Score: 0.00 X-FXIT-IP: IPv4[213.193.80.99] Epoch[1487678378] X-Bluewin-AuthAs: daniel.llorens@bluewin.ch X-Mailer: git-send-email 2.10.1 In-Reply-To: <20170221115935.32734-1-daniel.llorens@bluewin.ch> X-CMAE-Envelope: MS4wfJRQI86IKsoGMkP4HTXnvDueCurLsfxqHMwJahXf8gsqOyfYrJhhYe6uULcxBWy8ADl6RijAtsOPDVAowKSFf4Lw8ncPIFFSjQJKQfkOW1VJoKwRfUhH VbAF5WV3m039eXALnAcP8HAupE6XAWSx9a+WjPOTpVbRRXXalbVVebyvR1JlTRfAEySOs/mFG0x6c+d8uc0Ca2SADFkGBolWQYA3nlvbaL48MtQHzqQrnudd X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-Received-From: 195.186.120.133 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.21 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 Original-Sender: "guile-devel" Xref: news.gmane.org gmane.lisp.guile.devel:18927 Archived-At: From: Daniel Llorens * libguile/array-handle.c (scm_array_handle_writable_elements): Fix error message. * libguile/array-map.c (scm_array_slice_for_each): Support non-zero lower bounds. Fix error messages. * test-suite/tests/array-map.test: Test scm_array_slice_for_each with non-zero lower bound argument. --- libguile/array-handle.c | 2 +- libguile/array-map.c | 22 +++++++++------------- test-suite/tests/array-map.test | 8 ++++++++ 3 files changed, 18 insertions(+), 14 deletions(-) diff --git a/libguile/array-handle.c b/libguile/array-handle.c index 89277d9..4c2fe0e 100644 --- a/libguile/array-handle.c +++ b/libguile/array-handle.c @@ -327,7 +327,7 @@ SCM * scm_array_handle_writable_elements (scm_t_array_handle *h) { if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM) - scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array"); + scm_wrong_type_arg_msg (NULL, 0, h->array, "array of Scheme values"); return ((SCM*)h->elements) + h->base; } diff --git a/libguile/array-map.c b/libguile/array-map.c index c2825bc..b6529c0 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -677,6 +677,7 @@ SCM_DEFINE (scm_array_slice_for_each, "array-slice-for-each", 2, 0, 1, "@end lisp") #define FUNC_NAME s_scm_array_slice_for_each { + SCM xargs = args; int const N = scm_ilength (args); int const frank = scm_to_int (frame_rank); int ocd; @@ -740,9 +741,9 @@ SCM_DEFINE (scm_array_slice_for_each, "array-slice-for-each", 2, 0, 1, assert((pool0+pool_size==pool) && "internal error"); #undef AFIC_ALLOC_ADVANCE - for (n=0; scm_is_pair(args); args=scm_cdr(args), ++n) + for (n=0, xargs=args; scm_is_pair(xargs); xargs=scm_cdr(xargs), ++n) { - args_[n] = scm_car(args); + args_[n] = scm_car(xargs); scm_array_get_handle(args_[n], ah+n); as[n] = scm_array_handle_dims(ah+n); rank[n] = scm_array_handle_rank(ah+n); @@ -750,29 +751,24 @@ SCM_DEFINE (scm_array_slice_for_each, "array-slice-for-each", 2, 0, 1, /* checks */ msg = NULL; if (frank<0) - msg = "bad frame rank"; + msg = "bad frame rank ~S, ~S"; else { for (n=0; n!=N; ++n) { if (rank[n]typed-array 'f64 2 '((9 1) (7 8)))) -- 2.10.1