diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 1ae15c2aa..b2473d1f9 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -7665,7 +7665,7 @@ An additional array function is available in the module @deffn {Scheme Procedure} array-copy src Return a new array with the same elements, type and shape as -@var{src}. However, the array increments may not be the same as those of +@var{src}. However, the array increments may be different from those of @var{src}. In the current implementation, the returned array will be in row-major order, but that might change in the future. Use @code{array-copy!} on an array of known order if that is a concern. @@ -7864,8 +7864,9 @@ indices into the original array are fixed) is. Before @w{version 2.0}, Guile had a feature called `enclosed arrays' to create special `array of arrays' objects. The functions in this section -do not need special types; instead, the frame rank is stated in each -function call, either implicitly or explicitly. +do not need special types; instead, the frame rank is given in the +arguments, either implicitly (through the number of indices) or +explicitly. @deffn {Scheme Procedure} array-cell-ref array idx @dots{} @deffnx {C Function} scm_array_cell_ref (array, idxlist) @@ -7878,8 +7879,8 @@ is smaller than @math{n}, then return the @math{(n-k)}-cell of For example: @lisp -(array-cell-ref #2((a b) (c d)) 0) @result{} #(a b) -(array-cell-ref #2((a b) (c d)) 1) @result{} #(c d) +(array-cell-ref #2((a b) (c d)) 0) @result{} #1(a b) +(array-cell-ref #2((a b) (c d)) 1) @result{} #1(c d) (array-cell-ref #2((a b) (c d)) 1 1) @result{} d (array-cell-ref #2((a b) (c d))) @result{} #2((a b) (c d)) @end lisp @@ -7941,13 +7942,13 @@ This function returns the modified @var{array}. For example: @lisp -(array-cell-set! (make-array 'a 2 2) b 1 1) +(array-cell-set! (make-array 'a 2 2) 'b 1 1) @result{} #2((a a) (a b)) (array-cell-set! (make-array 'a 2 2) #(x y) 1) @result{} #2((a a) (x y)) @end lisp -Note that @code{array-cell-set!} will expect elements, not arrays, when +Note that @code{array-cell-set!} expects elements, not arrays, when the destination has rank 0. Use @code{array-slice} for the opposite behavior. @@ -7986,7 +7987,7 @@ manually. The slices passed to @var{op} are always shared arrays of This function returns an unspecified value. -For example, to sort the rows of rank-2 array @code{a}: +For example, to sort each row of rank-2 array @code{a}: @lisp (array-slice-for-each 1 (lambda (x) (sort! x <)) a) diff --git a/libguile/arrays.c b/libguile/arrays.c index 924ee0094..25391d4c3 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -503,47 +503,43 @@ scm_i_make_array (int ndim) return ra; } -static char s_bad_spec[] = "Bad scm_array dimension"; - - /* Increments will still need to be set. */ SCM scm_i_shap2ra (SCM args) { scm_t_array_dim *s; - SCM ra, spec; int ndim = scm_ilength (args); if (ndim < 0) - scm_misc_error (NULL, s_bad_spec, SCM_EOL); + scm_misc_error (NULL, "bad array bounds ~a", scm_list_1 (args)); - ra = scm_i_make_array (ndim); + SCM ra = scm_i_make_array (ndim); SCM_I_ARRAY_SET_BASE (ra, 0); s = SCM_I_ARRAY_DIMS (ra); for (; !scm_is_null (args); s++, args = SCM_CDR (args)) { - spec = SCM_CAR (args); + SCM spec = SCM_CAR (args); if (scm_is_integer (spec)) { s->lbnd = 0; s->ubnd = scm_to_ssize_t (spec); if (s->ubnd < 0) - scm_misc_error (NULL, s_bad_spec, SCM_EOL); + scm_misc_error (NULL, "negative array dimension ~a", scm_list_1 (spec)); --s->ubnd; } else { if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec))) - scm_misc_error (NULL, s_bad_spec, SCM_EOL); + scm_misc_error (NULL, "bad array bound ~a", scm_list_1 (spec)); s->lbnd = scm_to_ssize_t (SCM_CAR (spec)); - spec = SCM_CDR (spec); - if (!scm_is_pair (spec) - || !scm_is_integer (SCM_CAR (spec)) - || !scm_is_null (SCM_CDR (spec))) - scm_misc_error (NULL, s_bad_spec, SCM_EOL); - s->ubnd = scm_to_ssize_t (SCM_CAR (spec)); + SCM rest = SCM_CDR (spec); + if (!scm_is_pair (rest) + || !scm_is_integer (SCM_CAR (rest)) + || !scm_is_null (SCM_CDR (rest))) + scm_misc_error (NULL, "bad array bound ~a", scm_list_1 (spec)); + s->ubnd = scm_to_ssize_t (SCM_CAR (rest)); if (s->ubnd - s->lbnd < -1) - scm_misc_error (NULL, s_bad_spec, SCM_EOL); + scm_misc_error (NULL, "bad array bound ~a", scm_list_1 (spec)); } s->inc = 1; } @@ -695,7 +691,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, scm_array_handle_release (&old_handle); if (old_min > new_min || old_max < new_max) - SCM_MISC_ERROR ("mapping out of range", SCM_EOL); + scm_misc_error (FUNC_NAME, "mapping out of range", SCM_EOL); if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) { SCM v = SCM_I_ARRAY_V (ra); @@ -712,18 +708,18 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, static void -array_from_pos (scm_t_array_handle *handle, size_t *ndim, size_t *k, SCM *i, ssize_t *pos, - scm_t_array_dim **s, char const * FUNC_NAME, SCM error_args) +array_from_pos (scm_t_array_handle *handle, size_t *k, SCM *i, ssize_t *pos, + scm_t_array_dim **s) { *s = scm_array_handle_dims (handle); - *k = *ndim = scm_array_handle_rank (handle); + *k = scm_array_handle_rank (handle); for (; *k>0 && scm_is_pair (*i); --*k, ++*s, *i=scm_cdr (*i)) { ssize_t ik = scm_to_ssize_t (scm_car (*i)); if (ik<(*s)->lbnd || ik>(*s)->ubnd) { - scm_array_handle_release (handle); - scm_misc_error (FUNC_NAME, "indices out of range", error_args); + s = NULL; + return; } *pos += (ik-(*s)->lbnd) * (*s)->inc; } @@ -733,16 +729,20 @@ static void array_from_get_o (scm_t_array_handle *handle, size_t k, scm_t_array_dim *s, ssize_t pos, SCM *o) { - scm_t_array_dim * os; - *o = scm_i_make_array (k); - SCM_I_ARRAY_SET_V (*o, handle->vector); - SCM_I_ARRAY_SET_BASE (*o, pos + handle->base); - os = SCM_I_ARRAY_DIMS (*o); - for (; k>0; --k, ++s, ++os) + if (k==scm_array_handle_rank (handle)) + *o = handle->array; + else { - os->ubnd = s->ubnd; - os->lbnd = s->lbnd; - os->inc = s->inc; + *o = scm_i_make_array (k); + SCM_I_ARRAY_SET_V (*o, handle->vector); + SCM_I_ARRAY_SET_BASE (*o, pos + handle->base); + scm_t_array_dim * os = SCM_I_ARRAY_DIMS (*o); + for (; k>0; --k, ++s, ++os) + { + os->ubnd = s->ubnd; + os->lbnd = s->lbnd; + os->inc = s->inc; + } } } @@ -760,23 +760,25 @@ SCM_DEFINE (scm_array_slice, "array-slice", 1, 0, 1, "@end lisp") #define FUNC_NAME s_scm_array_slice { - SCM o, i = indices; - size_t ndim, k; - ssize_t pos = 0; scm_t_array_handle handle; - scm_t_array_dim *s; scm_array_get_handle (ra, &handle); - array_from_pos (&handle, &ndim, &k, &i, &pos, &s, FUNC_NAME, scm_list_2 (ra, indices)); - if (k==ndim) - o = ra; - else if (scm_is_null (i)) + SCM i = indices; + size_t k; + ssize_t pos = 0; + scm_t_array_dim *s; + array_from_pos (&handle, &k, &i, &pos, &s); + if (!s) { - array_from_get_o(&handle, k, s, pos, &o); + scm_array_handle_release (&handle); + scm_misc_error (FUNC_NAME, "indices ~a out of range for array bounds ~a", scm_list_2 (indices, scm_array_dimensions (ra))); } + SCM o; + if (scm_is_null (i)) + array_from_get_o (&handle, k, s, pos, &o); else { scm_array_handle_release (&handle); - scm_misc_error(FUNC_NAME, "too many indices", scm_list_2 (ra, indices)); + scm_misc_error (FUNC_NAME, "too many indices ~a for rank ~a", scm_list_2 (indices, scm_array_rank (ra))); } scm_array_handle_release (&handle); return o; @@ -799,26 +801,27 @@ SCM_DEFINE (scm_array_cell_ref, "array-cell-ref", 1, 0, 1, "@end lisp") #define FUNC_NAME s_scm_array_cell_ref { - SCM o, i = indices; - size_t ndim, k; - ssize_t pos = 0; scm_t_array_handle handle; - scm_t_array_dim *s; scm_array_get_handle (ra, &handle); - array_from_pos (&handle, &ndim, &k, &i, &pos, &s, FUNC_NAME, scm_list_2 (ra, indices)); - if (k>0) + SCM i = indices; + size_t k; + ssize_t pos = 0; + scm_t_array_dim *s; + array_from_pos (&handle, &k, &i, &pos, &s); + if (!s) { - if (k==ndim) - o = ra; - else - array_from_get_o(&handle, k, s, pos, &o); + scm_array_handle_release (&handle); + scm_misc_error (FUNC_NAME, "indices ~a out of range for array bounds ~a", scm_list_2 (indices, scm_array_dimensions (ra))); } + SCM o; + if (k>0) + array_from_get_o (&handle, k, s, pos, &o); else if (scm_is_null(i)) o = scm_array_handle_ref (&handle, pos); else { scm_array_handle_release (&handle); - scm_misc_error(FUNC_NAME, "too many indices", scm_list_2 (ra, indices)); + scm_misc_error (FUNC_NAME, "too many indices ~a for rank ~a", scm_list_2 (indices, scm_array_rank (ra))); } scm_array_handle_release (&handle); return o; @@ -846,19 +849,22 @@ SCM_DEFINE (scm_array_cell_set_x, "array-cell-set!", 2, 0, 1, "@end lisp") #define FUNC_NAME s_scm_array_cell_set_x { - SCM o, i = indices; - size_t ndim, k; - ssize_t pos = 0; scm_t_array_handle handle; - scm_t_array_dim *s; scm_array_get_handle (ra, &handle); - array_from_pos (&handle, &ndim, &k, &i, &pos, &s, FUNC_NAME, scm_list_3 (ra, b, indices)); + SCM i = indices; + size_t k; + ssize_t pos = 0; + scm_t_array_dim *s; + array_from_pos (&handle, &k, &i, &pos, &s); + if (!s) + { + scm_array_handle_release (&handle); + scm_misc_error (FUNC_NAME, "indices ~a out of range for array bounds ~a", scm_list_2 (indices, scm_array_dimensions (ra))); + } if (k>0) { - if (k==ndim) - o = ra; - else - array_from_get_o(&handle, k, s, pos, &o); + SCM o; + array_from_get_o(&handle, k, s, pos, &o); scm_array_handle_release(&handle); /* an error is still possible here if o and b don't match. */ /* FIXME copying like this wastes the handle, and the bounds matching @@ -873,7 +879,7 @@ SCM_DEFINE (scm_array_cell_set_x, "array-cell-set!", 2, 0, 1, else { scm_array_handle_release (&handle); - scm_misc_error(FUNC_NAME, "too many indices", scm_list_3 (ra, b, indices)); + scm_misc_error (FUNC_NAME, "too many indices ~a for rank ~a", scm_list_2 (indices, scm_array_rank (ra))); } return ra; }