Clean up (array-for-each-cell)

* libguile/array-map.c (array-for-each-cell,
  array-for-each-cell-in-order): Moved from libguile/arrays.c. Fix
  argument names. Complete docstring.

* libguile/array-map.h (array-for-each-cell,
  array-for-each-cell-in-order): Declarations moved from
  libguile/arrays.h.

* test-suite/tests/array-map.test: Renamed from
  test-suite/tests/ramap.test, fix module name.

  Add tests for (array-for-each-cell).

* test-suite/Makefile.am: Apply rename array-map.test -> ramap.test.

* doc/ref/api-compound.texi: Minor documentation fixes.

doc/ref/api-compound.texi

@@ -1795,14 +1795,12 @@ of @var{idxlist} is shorter than @math{n}, then return the shared
 
 For example:
 
-@example
 @lisp
 (array-from #2((a b) (c d)) 0) @result{} #(a b)
 (array-from #2((a b) (c d)) 1) @result{} #(c d)
 (array-from #2((a b) (c d)) 1 1) @result{} d
 (array-from #2((a b) (c d))) @result{} #2((a b) (c d))
 @end lisp
-@end example
 
 @code{(apply array-from array indices)} is equivalent to
 
@@ -1827,7 +1825,6 @@ write into.
 
 Compare:
 
-@example
 @lisp
 (array-from #2((a b) (c d)) 1 1) @result{} d
 (array-from* #2((a b) (c d)) 1) @result{} #0(d)
@@ -1836,7 +1833,6 @@ Compare:
 a @result{} #2((a a) (a b)).
 (array-fill! (array-from a 1 1) 'b) @result{} error: not an array
 @end lisp
-@end example
 
 @code{(apply array-from* array indices)} is equivalent to
 
@@ -1863,12 +1859,19 @@ This function returns the modified @var{array}.
 
 For example:
 
-@example
 @lisp
 (array-amend! (make-array 'a 2 2) b 1 1) @result{} #2((a a) (a b))
 (array-amend! (make-array 'a 2 2) #(x y) 1) @result{} #2((a a) (x y))
 @end lisp
-@end example
+
+Note that @code{array-amend!} will expect elements, not arrays, when the
+destination has rank 0. One can work around this using
+@code{array-from*} instead.
+
+@lisp
+(array-amend! (make-array 'a 2 2) #0(b) 1 1) @result{} #2((a a) (a #0(b)))
+(let ((a (make-array 'a 2 2))) (array-copy! #0(b) (array-from* a 1 1)) a) @result{} #2((a a) (a b))
+@end lisp
 
 @code{(apply array-amend! array x indices)} is equivalent to
 
@@ -1886,10 +1889,10 @@ The name `amend' comes from the J language.
 
 @deffn {Scheme Procedure} array-for-each-cell frame-rank op x @dots{}
 @deffnx {C Function} scm_array_for_each_cell (array, frame_rank, op, xlist)
-Each @var{x} must be an array of rank @math{n_x} ≥ @var{frame-rank}, and
+Each @var{x} must be an array of rank ≥ @var{frame-rank}, and
 the first @var{frame-rank} dimensions of each @var{x} must all be the
 same. @var{array-for-each-cell} calls @var{op} with each set of
-(@math{n_x} - @var{frame-rank})-cells from @var{x}, in unspecified order.
+(rank(@var{x}) - @var{frame-rank})-cells from @var{x}, in unspecified order.
 
 @var{array-for-each-cell} allows you to loop over cells of any rank
 without having to carry an index list or construct slices manually. The
@@ -1898,26 +1901,20 @@ to write to them.
 
 This function returns an unspecified value.
 
-For example:
+For example, to sort the rows of rank-2 array @code{a}:
 
-@example
-Sort the rows of rank-2 array @code{a}:
 @lisp
 (array-for-each-cell 1 (lambda (x) (sort! x <)) a)
 @end lisp
-@end example
 
-@example
+As another example, let @code{a} be a rank-2 array where each row is a 2-vector @math{(x,y)}.
-Let @code{a} be a rank-2 array where each row is a 2-vector @math{x,
+Let's compute the arguments of these vectors and store them in rank-1 array @code{b}.
-y}. Compute the norms of these vectors and store them in rank-1 array
-@code{b}:
 @lisp
 (array-for-each-cell 1
   (lambda (a b)
-    (array-set! b (hypot (array-ref a 0) (array-ref a 1))))
+    (array-set! b (atan (array-ref a 1) (array-ref a 0))))
   a b)
 @end lisp
-@end example
 
 @code{(apply array-for-each-cell frame-rank op x)} is functionally
 equivalent to
@@ -1933,7 +1930,6 @@ equivalent to
     (lambda i (apply op (map (lambda (x) (apply array-from* x i)) x)))))
 @end lisp
 
-The name `amend' comes from the J language.
 @end deffn
 
 

libguile/array-map.c

@@ -42,6 +42,8 @@
 
 #include "libguile/validate.h"
 #include "libguile/array-map.h"
+
+#include <assert.h>
 
 
 /* The WHAT argument for `scm_gc_malloc ()' et al.  */
@@ -624,7 +626,8 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
     return SCM_BOOL_T;
 
   while (!scm_is_null (rest))
-    { if (scm_is_false (scm_array_equal_p (ra0, ra1)))
+    {
+      if (scm_is_false (scm_array_equal_p (ra0, ra1)))
         return SCM_BOOL_F;
       ra0 = ra1;
       ra1 = scm_car (rest);
@@ -635,6 +638,244 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
 #undef FUNC_NAME
 
 
+// Copy array descriptor with different base.
+SCM
+scm_i_array_rebase (SCM a, size_t base)
+{
+    size_t ndim = SCM_I_ARRAY_NDIM (a);
+    SCM b = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3);
+    SCM_I_ARRAY_SET_V (b, SCM_I_ARRAY_V (a));
+// FIXME do check base
+    SCM_I_ARRAY_SET_BASE (b, base);
+    memcpy (SCM_I_ARRAY_DIMS (b), SCM_I_ARRAY_DIMS (a), sizeof (scm_t_array_dim)*ndim);
+    return b;
+}
+
+SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1,
+            (SCM frame_rank, SCM op, SCM args),
+            "Apply @var{op} to each of the cells of rank rank(@var{arg})-@var{frame_rank}\n"
+            "of the arrays @var{args}, in unspecified order. The first\n"
+            "@var{frame_rank} dimensions of each @var{arg} must match.\n"
+            "Rank-0 cells are passed as rank-0 arrays.\n\n"
+            "The value returned is unspecified.\n\n"
+            "For example:\n"
+            "@lisp\n"
+            ";; Sort the rows of rank-2 array A.\n\n"
+            "(array-for-each-cell 1 (lambda (x) (sort! x <)) a)\n"
+            "\n"
+            ";; Compute the arguments of the (x y) vectors in the rows of rank-2\n"
+            ";; array XYS and store them in rank-1 array ANGLES. Inside OP,\n"
+            ";; XY is a rank-1 (2-1) array, and ANGLE is a rank-0 (1-1) array.\n\n"
+            "(array-for-each-cell 1 \n"
+            "  (lambda (xy angle)\n"
+            "    (array-set! angle (atan (array-ref xy 1) (array-ref xy 0))))\n"
+            "  xys angles)\n"
+            "@end lisp")
+#define FUNC_NAME s_scm_array_for_each_cell
+{
+  int const N = scm_ilength (args);
+  int const frank = scm_to_int (frame_rank);
+
+  // wish C had better stack support
+
+  size_t stack_size = 0;
+  stack_size += N*sizeof (scm_t_array_handle);
+  stack_size += N*sizeof (SCM);
+  stack_size += N*sizeof (scm_t_array_dim *);
+  stack_size += N*sizeof (int);
+  stack_size += frank*sizeof (ssize_t);
+
+  stack_size += N*sizeof (SCM);
+  stack_size += N*sizeof (SCM *);
+  stack_size += frank*sizeof (ssize_t);
+  stack_size += frank*sizeof (int);
+
+  stack_size += N*sizeof (size_t);
+  char * stack = scm_gc_malloc_pointerless (stack_size, "stack");
+
+#define AFIC_ALLOC_ADVANCE(stack, count, type, name)    \
+  type * name = (void *)stack;                          \
+  stack += count*sizeof (type);
+
+  char * stack0 = stack;
+  AFIC_ALLOC_ADVANCE (stack, N, scm_t_array_handle, ah);
+  AFIC_ALLOC_ADVANCE (stack, N, SCM, args_);
+  AFIC_ALLOC_ADVANCE (stack, N, scm_t_array_dim *, as);
+  AFIC_ALLOC_ADVANCE (stack, N, int, rank);
+  AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, s);
+
+  AFIC_ALLOC_ADVANCE (stack, N, SCM, ai);
+  AFIC_ALLOC_ADVANCE (stack, N, SCM *, dargs);
+  AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, i);
+  AFIC_ALLOC_ADVANCE (stack, frank, int, order);
+
+  AFIC_ALLOC_ADVANCE(stack, N, size_t, base);
+  assert((stack0+stack_size==stack) && "internal error");
+#undef AFIC_ALLOC_ADVANCE
+
+  for (int n=0; scm_is_pair(args); args=scm_cdr(args), ++n)
+    {
+      args_[n] = scm_car(args);
+      scm_array_get_handle(args_[n], ah+n);
+      as[n] = scm_array_handle_dims(ah+n);
+      rank[n] = scm_array_handle_rank(ah+n);
+    }
+  // checks.
+  char const * msg = NULL;
+  if (frank<0)
+    {
+      msg = "bad frame rank";
+    } else
+    {
+      for (int n=0; n!=N; ++n) {
+        if (rank[n]<frank) {
+          msg = "frame too large for arguments";
+          goto check_msg;
+        }
+        for (int k=0; k!=frank; ++k) {
+          if (as[n][k].lbnd!=0) {
+            msg = "non-zero base index is not supported";
+            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;
+        }
+      }
+    }
+ check_msg: ;
+  if (msg!=NULL)
+    {
+      for (int n=0; n!=N; ++n) {
+        scm_array_handle_release(ah+n);
+      }
+      scm_misc_error("array-for-each-cell", msg, scm_cons_star(frame_rank, args));
+    }
+  // prepare moving cells.
+  scm_t_array_dim * ais[N];
+  for (int n=0; n!=N; ++n)
+    {
+      ai[n] = scm_i_make_array(rank[n]-frank);
+      SCM_I_ARRAY_SET_V (ai[n], scm_shared_array_root(args_[n]));
+      // FIXME scm_array_handle_base (ah+n) should be in Guile
+      SCM_I_ARRAY_SET_BASE (ai[n], ah[n].base);
+      ais[n] = SCM_I_ARRAY_DIMS(ai[n]);
+      for (int k=frank; k!=rank[n]; ++k) {
+        ais[n][k-frank] = as[n][k];
+      }
+    }
+  // prepare rest list for callee.
+  SCM dargs_ = SCM_EOL;
+  {
+    SCM *p = &dargs_;
+    for (int n=0; n<N; ++n) {
+      *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
+      dargs[n] = SCM_CARLOC (*p);
+      p = SCM_CDRLOC (*p);
+    }
+  }
+  // special case for rank 0.
+  if (frank==0)
+    {
+      for (int n=0; n<N; ++n)
+        {
+          *dargs[n] = ai[n];
+        }
+      scm_apply_0(op, dargs_);
+      for (int n=0; n<N; ++n)
+        {
+          scm_array_handle_release(ah+n);
+        }
+      return SCM_UNSPECIFIED;
+    }
+  // FIXME determine best looping order.
+  for (int k=0; k!=frank; ++k)
+    {
+      i[k] = 0;
+      order[k] = frank-1-k;
+    }
+  // find outermost compact dim.
+  ssize_t step = s[order[0]];
+  int ocd = 1;
+  for (; ocd<frank; step *= s[order[ocd]], ++ocd)
+    {
+      for (int n=0; n!=N; ++n) {
+        if (step*as[n][order[0]].inc!=as[n][order[ocd]].inc) {
+          goto ocd_reached;
+        }
+      }
+    }
+ ocd_reached: ;
+  // rank loop.
+  for (int n=0; n!=N; ++n)
+    {
+      base[n] = SCM_I_ARRAY_BASE(ai[n]);
+    }
+  for (;;)
+    {
+      for (ssize_t z=0; z!=step; ++z)
+        {
+          // we are forced to create fresh array descriptors for each
+          // call since we don't know whether the callee will keep them,
+          // and Guile offers no way to copy the descriptor (since
+          // descriptors are immutable). Yet another reason why this
+          // should be in Scheme.
+          for (int n=0; n<N; ++n)
+            {
+              *dargs[n] = scm_i_array_rebase(ai[n], base[n]);
+              base[n] += as[n][order[0]].inc;
+            }
+          scm_apply_0(op, dargs_);
+        }
+      for (int n=0; n<N; ++n)
+        {
+          base[n] -= step*as[n][order[0]].inc;
+        }
+      for (int k=ocd; ; ++k)
+        {
+          if (k==frank)
+            {
+              goto end;
+            } else if (i[order[k]]<s[order[k]]-1)
+            {
+              ++i[order[k]];
+              for (int n=0; n<N; ++n)
+                {
+                  base[n] += as[n][order[k]].inc;
+                }
+              break;
+            } else {
+            i[order[k]] = 0;
+            for (int n=0; n<N; ++n)
+              {
+                base[n] += as[n][order[k]].inc*(1-s[order[k]]);
+              }
+          }
+        }
+    }
+ end:;
+  for (int n=0; n<N; ++n)
+    {
+      scm_array_handle_release(ah+n);
+    }
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_for_each_cell_in_order, "array-for-each-cell-in-order", 2, 0, 1,
+            (SCM frank, SCM op, SCM a),
+            "Same as array-for-each-cell, but visit the cells sequentially\n"
+            "and in row-major order.\n")
+#define FUNC_NAME s_scm_array_for_each_cell_in_order
+{
+  return scm_array_for_each_cell (frank, op, a);
+}
+#undef FUNC_NAME
+
+
 void
 scm_init_array_map (void)
 {
@@ -642,6 +883,7 @@ scm_init_array_map (void)
   scm_add_feature (s_scm_array_for_each);
 }
 
+
 /*
   Local Variables:
   c-file-style: "gnu"

libguile/array-map.h

@@ -37,6 +37,9 @@ SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
 SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
 SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
 SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1);
+SCM_API SCM scm_array_for_each_cell (SCM frank, SCM op, SCM args);
+SCM_API SCM scm_array_for_each_cell_in_order (SCM frank, SCM op, SCM args);
+
 SCM_INTERNAL void scm_init_array_map (void);
 
 #endif  /* SCM_ARRAY_MAP_H */

libguile/arrays.c

@@ -28,7 +28,6 @@
 #include <stdio.h>
 #include <errno.h>
 #include <string.h>
-#include <assert.h>
 
 #include "verify.h"
 
@@ -568,233 +567,6 @@ SCM_DEFINE (scm_array_amend_x, "array-amend!", 2, 0, 1,
 #undef ARRAY_FROM_GET_O
 
 
-// Copy array descriptor with different base.
-SCM
-scm_i_array_rebase (SCM a, size_t base)
-{
-    size_t ndim = SCM_I_ARRAY_NDIM(a);
-    SCM b = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3);
-    SCM_I_ARRAY_SET_V (b, SCM_I_ARRAY_V (a));
-// FIXME do check base
-    SCM_I_ARRAY_SET_BASE (b, base);
-    memcpy(SCM_I_ARRAY_DIMS(b), SCM_I_ARRAY_DIMS(a), sizeof(scm_t_array_dim)*ndim);
-    return b;
-}
-
-SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1,
-            (SCM frank_, SCM op, SCM a_),
-            "Apply op to each of the rank (-frank) cells of the arguments,\n"
-            "in unspecified order. The first frank dimensions of the\n"
-            "arguments must match. Rank-0 cells are passed as such.\n\n"
-            "The value returned is unspecified.\n\n"
-            "For example:\n"
-            "@lisp\n"
-            "@end lisp")
-#define FUNC_NAME s_scm_array_for_each_cell
-{
-  int const N = scm_ilength (a_);
-  int const frank = scm_to_int (frank_);
-
-  // wish C had better stack support
-
-  size_t stack_size = 0;
-  stack_size += N*sizeof (scm_t_array_handle);
-  stack_size += N*sizeof (SCM);
-  stack_size += N*sizeof (scm_t_array_dim *);
-  stack_size += N*sizeof (int);
-  stack_size += frank*sizeof (ssize_t);
-
-  stack_size += N*sizeof (SCM);
-  stack_size += N*sizeof (SCM *);
-  stack_size += frank*sizeof (ssize_t);
-  stack_size += frank*sizeof (int);
-
-  stack_size += N*sizeof(size_t);
-  char * stack = scm_gc_malloc_pointerless (stack_size, "stack");
-
-#define AFIC_ALLOC_ADVANCE(stack, count, type, name)    \
-  type * name = (void *)stack;                          \
-  stack += count*sizeof(type);
-
-  char * stack0 = stack;
-  AFIC_ALLOC_ADVANCE (stack, N, scm_t_array_handle, ah);
-  AFIC_ALLOC_ADVANCE (stack, N, SCM, a);
-  AFIC_ALLOC_ADVANCE (stack, N, scm_t_array_dim *, as);
-  AFIC_ALLOC_ADVANCE (stack, N, int, rank);
-  AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, s);
-
-  AFIC_ALLOC_ADVANCE (stack, N, SCM, ai);
-  AFIC_ALLOC_ADVANCE (stack, N, SCM *, dargs);
-  AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, i);
-  AFIC_ALLOC_ADVANCE (stack, frank, int, order);
-
-  AFIC_ALLOC_ADVANCE(stack, N, size_t, base);
-  assert((stack0+stack_size==stack) && "internal error");
-#undef AFIC_ALLOC_ADVANCE
-
-  for (int n=0; scm_is_pair(a_); a_=scm_cdr(a_), ++n)
-    {
-      a[n] = scm_car(a_);
-      scm_array_get_handle(a[n], ah+n);
-      as[n] = scm_array_handle_dims(ah+n);
-      rank[n] = scm_array_handle_rank(ah+n);
-    }
-  // checks.
-  char const * msg = NULL;
-  if (frank<0)
-    {
-      msg = "bad frame rank";
-    } else
-    {
-      for (int n=0; n!=N; ++n) {
-        if (rank[n]<frank) {
-          msg = "frame too large for arguments";
-          goto check_msg;
-        }
-        for (int k=0; k!=frank; ++k) {
-          if (as[n][k].lbnd!=0) {
-            msg = "non-zero base index is not supported";
-            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;
-        }
-      }
-    }
- check_msg: ;
-  if (msg!=NULL)
-    {
-      for (int n=0; n!=N; ++n) {
-        scm_array_handle_release(ah+n);
-      }
-      scm_misc_error("array-for-each-cell", msg, scm_cons_star(frank_, a_));
-    }
-  // prepare moving cells.
-  scm_t_array_dim * ais[N];
-  for (int n=0; n!=N; ++n)
-    {
-      ai[n] = scm_i_make_array(rank[n]-frank);
-      SCM_I_ARRAY_SET_V (ai[n], scm_shared_array_root(a[n]));
-      // FIXME scm_array_handle_base (ah+n) should be in Guile
-      SCM_I_ARRAY_SET_BASE (ai[n], ah[n].base);
-      ais[n] = SCM_I_ARRAY_DIMS(ai[n]);
-      for (int k=frank; k!=rank[n]; ++k) {
-        ais[n][k-frank] = as[n][k];
-      }
-    }
-  // prepare rest list for callee.
-  SCM dargs_ = SCM_EOL;
-  {
-    SCM *p = &dargs_;
-    for (int n=0; n<N; ++n) {
-      *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
-      dargs[n] = SCM_CARLOC (*p);
-      p = SCM_CDRLOC (*p);
-    }
-  }
-  // special case for rank 0.
-  if (frank==0)
-    {
-      for (int n=0; n<N; ++n)
-        {
-          *dargs[n] = ai[n];
-        }
-      scm_apply_0(op, dargs_);
-      for (int n=0; n<N; ++n)
-        {
-          scm_array_handle_release(ah+n);
-        }
-      return SCM_UNSPECIFIED;
-    }
-  // FIXME determine best looping order.
-  for (int k=0; k!=frank; ++k)
-    {
-      i[k] = 0;
-      order[k] = frank-1-k;
-    }
-  // find outermost compact dim.
-  ssize_t step = s[order[0]];
-  int ocd = 1;
-  for (; ocd<frank; step *= s[order[ocd]], ++ocd)
-    {
-      for (int n=0; n!=N; ++n) {
-        if (step*as[n][order[0]].inc!=as[n][order[ocd]].inc) {
-          goto ocd_reached;
-        }
-      }
-    }
- ocd_reached: ;
-  // rank loop.
-  for (int n=0; n!=N; ++n)
-    {
-      base[n] = SCM_I_ARRAY_BASE(ai[n]);
-    }
-  for (;;)
-    {
-      for (ssize_t z=0; z!=step; ++z)
-        {
-          // we are forced to create fresh array descriptors for each
-          // call since we don't know whether the callee will keep them,
-          // and Guile offers no way to copy the descriptor (since
-          // descriptors are immutable). Yet another reason why this
-          // should be in Scheme.
-          for (int n=0; n<N; ++n)
-            {
-              *dargs[n] = scm_i_array_rebase(ai[n], base[n]);
-              base[n] += as[n][order[0]].inc;
-            }
-          scm_apply_0(op, dargs_);
-        }
-      for (int n=0; n<N; ++n)
-        {
-          base[n] -= step*as[n][order[0]].inc;
-        }
-      for (int k=ocd; ; ++k)
-        {
-          if (k==frank)
-            {
-              goto end;
-            } else if (i[order[k]]<s[order[k]]-1)
-            {
-              ++i[order[k]];
-              for (int n=0; n<N; ++n)
-                {
-                  base[n] += as[n][order[k]].inc;
-                }
-              break;
-            } else {
-            i[order[k]] = 0;
-            for (int n=0; n<N; ++n)
-              {
-                base[n] += as[n][order[k]].inc*(1-s[order[k]]);
-              }
-          }
-        }
-    }
- end:;
-  for (int n=0; n<N; ++n)
-    {
-      scm_array_handle_release(ah+n);
-    }
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_for_each_cell_in_order, "array-for-each-cell-in-order", 2, 0, 1,
-            (SCM frank_, SCM op, SCM a_),
-            "Same as array-for-each-cell, but visit the cells sequentially\n"
-            "and in row-major order.\n")
-#define FUNC_NAME s_scm_array_for_each_cell_in_order
-{
-  return scm_array_for_each_cell (frank_, op, a_);
-}
-#undef FUNC_NAME
-
-
 /* args are RA . DIMS */
 SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
            (SCM ra, SCM args),

libguile/arrays.h

@@ -52,8 +52,6 @@ SCM_API SCM scm_array_contents (SCM ra, SCM strict);
 SCM_API SCM scm_array_from_s (SCM ra, SCM indices);
 SCM_API SCM scm_array_from (SCM ra, SCM indices);
 SCM_API SCM scm_array_amend_x (SCM ra, SCM b, SCM indices);
-SCM_API SCM scm_array_for_each_cell (SCM frank, SCM op, SCM args);
-SCM_API SCM scm_array_for_each_cell_in_order (SCM frank, SCM op, SCM args);
 
 SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
 SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);

test-suite/Makefile.am

@@ -115,7 +115,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/r6rs-records-syntactic.test	\
 	    tests/r6rs-unicode.test		\
 	    tests/rnrs-libraries.test		\
-	    tests/ramap.test			\
+	    tests/array-map.test		\
 	    tests/random.test			\
 	    tests/rdelim.test			\
 	    tests/reader.test			\

test-suite/tests/array-map.test

@@ -1,4 +1,4 @@
-;;;; ramap.test --- test array mapping functions -*- scheme -*-
+;;;; array-map.test --- test array mapping functions -*- scheme -*-
 ;;;;
 ;;;; Copyright (C) 2004, 2005, 2006, 2009, 2013 Free Software Foundation, Inc.
 ;;;;
@@ -16,7 +16,7 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-(define-module (test-suite test-ramap)
+(define-module (test-suite test-array-map)
   #:use-module (test-suite lib))
 
 (define exception:shape-mismatch
@@ -507,3 +507,22 @@
              (b (make-typed-array 'f64 0 0 2))
              (c (make-typed-array 'f64 0 2 0)))
         (array-for-each (lambda (b c) (set! a (cons* b c a))) b c)))))
+
+;;;
+;;; array-for-each-cell
+;;;
+
+(with-test-prefix "array-for-each-cell"
+
+  (pass-if-equal "1 argument frame rank 1"
+      #2((1 3 9) (2 7 8))
+      (let* ((a (list->array 2 '((9 1 3) (7 8 2)))))
+        (array-for-each-cell 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))))
+             (y (f64vector 99 99)))
+        (array-for-each-cell 1 (lambda (y x) (array-set! y (- (array-ref x 0) (array-ref x 1)))) y x)
+        y)))