[Guile-commits] branch main updated: Better error messages in array functions

[Daniel Llorens]

This is an automated email from the git hooks/post-receive script.

lloda pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new 83d6d6afd Better error messages in array functions
83d6d6afd is described below

commit 83d6d6afd9e4756b507d0ab71f2d48b1d53eaf54
Author: Daniel Llorens <lloda@sarc.name>
AuthorDate: Mon Aug 12 13:35:32 2024 +0200

    Better error messages in array functions
    
    * 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.
---
 doc/ref/api-data.texi |  17 +++----
 libguile/arrays.c     | 130 ++++++++++++++++++++++++++------------------------
 2 files changed, 77 insertions(+), 70 deletions(-)

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