[Guile-commits] GNU Guile branch, master, updated. v2.1.0-636-gf0521cd

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f0521cdabcad69db03edb0db8772572bf539170b

The branch, master has been updated
       via  f0521cdabcad69db03edb0db8772572bf539170b (commit)
      from  16259ae3dcf4f121ec1ba3aa49090dfa9fef995f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
-----------------------------------------------------------------------

Summary of changes:
 libguile/array-map.c |  134 ++++++++++++++++++++++++++++----------------------
 1 files changed, 75 insertions(+), 59 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 961d474..658e81e 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -92,20 +92,20 @@ scm_ra_matchp (SCM ra0, SCM ras)
   int i, ndim = 1;
   int exact = 2          /* 4 */ ;  /* Don't care about values >2 (yet?) */
 
-  if (!scm_is_array (ra0))
-    return 0;
-  else if (!SCM_I_ARRAYP (ra0))
+  if (SCM_I_ARRAYP (ra0))
+    {
+      ndim = SCM_I_ARRAY_NDIM (ra0);
+      s0 = SCM_I_ARRAY_DIMS (ra0);
+      bas0 = SCM_I_ARRAY_BASE (ra0);
+    }
+  else if (scm_is_array (ra0))
     {
       s0->lbnd = 0;
       s0->inc = 1;
       s0->ubnd = scm_c_array_length (ra0) - 1;
     }
   else
-    {
-      ndim = SCM_I_ARRAY_NDIM (ra0);
-      s0 = SCM_I_ARRAY_DIMS (ra0);
-      bas0 = SCM_I_ARRAY_BASE (ra0);
-    }
+    return 0;
 
   while (scm_is_pair (ras))
     {
@@ -778,6 +778,62 @@ SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
 }
 #undef FUNC_NAME
 
+static SCM
+array_index_map_1 (SCM ra, SCM proc)
+{
+  unsigned long i;
+  size_t length = scm_c_array_length (ra);
+  for (i = 0; i < length; ++i)
+    ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
+  return SCM_UNSPECIFIED;
+}
+
+/* Here we assume that the array is a scm_tc7_array, as that is the only
+   kind of array in Guile that supports rank > 1.  */
+static SCM
+array_index_map_n (SCM ra, SCM proc)
+{
+  SCM args = SCM_EOL;
+  int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
+  unsigned long i;
+  long *vinds;
+
+  vinds = scm_gc_malloc_pointerless (sizeof(long) * SCM_I_ARRAY_NDIM (ra),
+                                     indices_gc_hint);
+
+  for (k = 0; k <= kmax; k++)
+    vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
+  k = kmax;
+  do
+    {
+      if (k == kmax)
+        {
+          vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
+          i = cind (ra, vinds);
+          for (; vinds[k] <= SCM_I_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++)
+            {
+              for (j = kmax + 1, args = SCM_EOL; j--;)
+                args = scm_cons (scm_from_long (vinds[j]), args);
+              ASET (SCM_I_ARRAY_V (ra), i, scm_apply_0 (proc, args));
+              i += SCM_I_ARRAY_DIMS (ra)[k].inc;
+            }
+          k--;
+          continue;
+        }
+      if (vinds[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
+        {
+          vinds[k]++;
+          k++;
+          continue;
+        }
+      vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1;
+      k--;
+    }
+  while (k >= 0);
+
+  return SCM_UNSPECIFIED;
+}
+
 SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
            (SCM ra, SCM proc),
            "Apply @var{proc} to the indices of each element of @var{ra} in\n"
@@ -799,62 +855,22 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 
0, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_array_index_map_x
 {
-  unsigned long i;
   SCM_VALIDATE_PROC (2, proc);
 
-  if (!scm_is_array (ra))
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-  else if (!SCM_I_ARRAYP (ra))
+  switch (scm_c_array_rank (ra))
     {
-      size_t length = scm_c_array_length (ra);
-      for (i = 0; i < length; ++i)
-       ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
-      return SCM_UNSPECIFIED;
+    case 0:
+      scm_array_set_x (ra, scm_call_0 (proc), SCM_EOL);
+      break;
+    case 1:
+      array_index_map_1 (ra, proc);
+      break;
+    default:
+      array_index_map_n (ra, proc);
+      break;
     }
-  else
-    {
-      SCM args = SCM_EOL;
-      int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
-      long *vinds;
-
-      if (kmax < 0)
-       return scm_array_set_x (ra, scm_call_0 (proc), SCM_EOL);
-
-      vinds = scm_gc_malloc_pointerless (sizeof(long) * SCM_I_ARRAY_NDIM (ra),
-                                        indices_gc_hint);
 
-      for (k = 0; k <= kmax; k++)
-       vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
-      k = kmax;
-      do
-       {
-         if (k == kmax)
-           {
-             vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
-             i = cind (ra, vinds);
-             for (; vinds[k] <= SCM_I_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++)
-               {
-                 for (j = kmax + 1, args = SCM_EOL; j--;)
-                   args = scm_cons (scm_from_long (vinds[j]), args);
-                 ASET (SCM_I_ARRAY_V (ra), i, scm_apply_0 (proc, args));
-                 i += SCM_I_ARRAY_DIMS (ra)[k].inc;
-               }
-             k--;
-             continue;
-           }
-         if (vinds[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
-           {
-             vinds[k]++;
-             k++;
-             continue;
-           }
-         vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1;
-         k--;
-       }
-      while (k >= 0);
-
-      return SCM_UNSPECIFIED;
-    }
+  return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 


hooks/post-receive
-- 
GNU Guile