From: daniel.llorens@bluewin.ch
To: guile-devel@gnu.org
Subject: [PATCH 4/6] Support non-zero lower bounds in array-slice-for-each
Date: Tue, 21 Feb 2017 12:59:33 +0100 [thread overview]
Message-ID: <20170221115935.32734-5-daniel.llorens@bluewin.ch> (raw)
In-Reply-To: <20170221115935.32734-1-daniel.llorens@bluewin.ch>
From: Daniel Llorens <daniel.llorens@bluewin.ch>
* 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]<frank)
{
- msg = "frame too large for arguments";
+ msg = "frame too large for arguments: ~S, ~S";
goto check_msg;
}
for (k=0; k!=frank; ++k)
{
- if (as[n][k].lbnd!=0)
+ if (as[0][k].lbnd!=as[n][k].lbnd || as[0][k].ubnd!=as[n][k].ubnd)
{
- msg = "non-zero base index is not supported";
+ msg = "mismatched frames: ~S, ~S";
goto check_msg;
}
- if (as[0][k].ubnd!=as[n][k].ubnd)
- {
- msg = "mismatched frames";
- goto check_msg;
- }
- s[k] = as[n][k].ubnd + 1;
+ s[k] = as[n][k].ubnd - as[n][k].lbnd + 1;
/* this check is needed if the array cannot be entirely */
/* unrolled, because the unrolled subloop will be run before */
@@ -787,7 +783,7 @@ SCM_DEFINE (scm_array_slice_for_each, "array-slice-for-each", 2, 0, 1,
{
for (n=0; n!=N; ++n)
scm_array_handle_release(ah+n);
- scm_misc_error("array-slice-for-each", msg, scm_cons_star(frame_rank, args));
+ scm_misc_error("array-slice-for-each", msg, scm_cons(frame_rank, args));
}
/* prepare moving cells. */
for (n=0; n!=N; ++n)
diff --git a/test-suite/tests/array-map.test b/test-suite/tests/array-map.test
index 3471841..8e0e769 100644
--- a/test-suite/tests/array-map.test
+++ b/test-suite/tests/array-map.test
@@ -520,6 +520,14 @@
(array-slice-for-each 1 (lambda (a) (sort! a <)) a)
a))
+ (pass-if-equal "1 argument frame rank 1, non-zero base indices"
+ #2@1@1((1 3 9) (2 7 8))
+ (let* ((a (make-array *unspecified* '(1 2) '(1 3)))
+ (b #2@1@1((9 1 3) (7 8 2))))
+ (array-copy! b a)
+ (array-slice-for-each 1 (lambda (a) (sort! a <)) a)
+ a))
+
(pass-if-equal "2 arguments frame rank 1"
#f64(8 -1)
(let* ((x (list->typed-array 'f64 2 '((9 1) (7 8))))
--
2.10.1
next prev parent reply other threads:[~2017-02-21 11:59 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-02-21 11:59 Better support for non-zero lower bound arrays [v2] daniel.llorens
2017-02-21 11:59 ` [PATCH 1/6] Replace uniform-vector-read benchmark with bytevector-io benchmark daniel.llorens
2017-02-21 11:59 ` [PATCH 2/6] Remove documentation on uniform-vector-read!, uniform-vector-write daniel.llorens
2017-02-21 11:59 ` [PATCH 3/6] Fix sort, sort! for arrays with nonzero lower bound daniel.llorens
2017-02-21 11:59 ` daniel.llorens [this message]
2017-02-21 11:59 ` [PATCH 5/6] Fix bitvectors and non-zero lower bound arrays in truncated-print daniel.llorens
2017-02-21 11:59 ` [PATCH 6/6] Remove scm_generalized_vector_get_handle daniel.llorens
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170221115935.32734-5-daniel.llorens@bluewin.ch \
--to=daniel.llorens@bluewin.ch \
--cc=guile-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).