mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Support non-zero lower bounds in array-slice-for-each

Browse source 
* 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.
This commit is contained in:
Daniel Llorens 2017-02-13 13:49:35 +01:00
parent 3bfd4aaa6e
commit f52fc0566f
2 changed files with 17 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/array-map.c
View file

@ -679,6 +679,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;
@ -742,9 +743,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);
@ -752,29 +753,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 */
@ -789,7 +785,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)

8
test-suite/tests/array-map.test
View file

@ -524,6 +524,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))))