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

Better error messages in array functions

Browse source 
* doc/ref/api-data.texi (Arrays as arrays of arrays): Clarify
  ambiguities, fix examples.
* libguile/arrays.c (make-shared-array): Make error messages specific to
  each error case, report relevant arguments.
  (array_from_pos): Return NULL on error instead of reporting error
  ourselves.
  (array_from_get_o): Handle the trivial case.
  (scm_array_slice, scm_array_cell_ref, scm_array_cell_set_x): Don't
  build error arguments before error happens. Let array_from_get_o
  handle the trivial case.
This commit is contained in:
Daniel Llorens 2024-08-12 13:35:32 +02:00
parent c03115c39d
commit 83d6d6afd9
2 changed files with 77 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

17
doc/ref/api-data.texi
View file

@ -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)

130
libguile/arrays.c
View file

@ -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;
}