Factor out make1array() in scm_ramapc()

* libguile/array-map.c: (scm_ramapc): factor out vector->array conversion
  to aux function make1array.

1 files changed, 93 insertions, 96 deletions

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 790f5dc00..db60c9635 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -152,6 +152,19 @@ scm_ra_matchp (SCM ra0, SCM ras)
   return empty ? 5 : exact;
 }
 
+
+static SCM
+make1array (SCM v)
+{
+  SCM a = scm_i_make_array (1);
+  SCM_I_ARRAY_BASE (a) = 0;
+  SCM_I_ARRAY_DIMS (a)->lbnd = 0;
+  SCM_I_ARRAY_DIMS (a)->ubnd = scm_c_array_length (v) - 1;
+  SCM_I_ARRAY_DIMS (a)->inc = 1;
+  SCM_I_ARRAY_V (a) = v;
+  return a;
+}
+
 /* array mapper: apply cproc to each dimension of the given arrays?.
      int (*cproc) ();   procedure to call on unrolled arrays?
 			   cproc (dest, source list) or
@@ -164,7 +177,7 @@ int
 scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
 {
   SCM z;
-  SCM vra0, ra1, vra1;
+  SCM vra0;
   SCM lvra, *plvra;
   long *vinds;
   int k, kmax;
@@ -185,22 +198,13 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
       if (scm_is_false (vra0))
         goto gencase;
       if (!SCM_I_ARRAYP (vra0))
-	{
-	  size_t length = scm_c_array_length (vra0);
-	  vra1 = scm_i_make_array (1);
-	  SCM_I_ARRAY_BASE (vra1) = 0;
-	  SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
-	  SCM_I_ARRAY_DIMS (vra1)->ubnd = length - 1;
-	  SCM_I_ARRAY_DIMS (vra1)->inc = 1;
-	  SCM_I_ARRAY_V (vra1) = vra0;
-	  vra0 = vra1;
-	}
+        vra0 = make1array (vra0);
       lvra = SCM_EOL;
       plvra = &lvra;
       for (z = lra; scm_is_pair (z); z = SCM_CDR (z))
 	{
-	  ra1 = SCM_CAR (z);
-	  vra1 = scm_i_make_array (1);
+	  SCM ra1 = SCM_CAR (z);
+	  SCM vra1 = scm_i_make_array (1);
 	  SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
 	  SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
 	  if (!SCM_I_ARRAYP (ra1))
@@ -224,90 +228,83 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
     case 1:
     gencase:			/* Have to loop over all dimensions. */
       vra0 = scm_i_make_array (1);
-    if (SCM_I_ARRAYP (ra0))
-      {
-	kmax = SCM_I_ARRAY_NDIM (ra0) - 1;
-	if (kmax < 0)
-	  {
-	    SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
-	    SCM_I_ARRAY_DIMS (vra0)->ubnd = 0;
-	    SCM_I_ARRAY_DIMS (vra0)->inc = 1;
-	  }
-	else
-	  {
-	    SCM_I_ARRAY_DIMS (vra0)->lbnd = SCM_I_ARRAY_DIMS (ra0)[kmax].lbnd;
-	    SCM_I_ARRAY_DIMS (vra0)->ubnd = SCM_I_ARRAY_DIMS (ra0)[kmax].ubnd;
-	    SCM_I_ARRAY_DIMS (vra0)->inc = SCM_I_ARRAY_DIMS (ra0)[kmax].inc;
-	  }
-	SCM_I_ARRAY_BASE (vra0) = SCM_I_ARRAY_BASE (ra0);
-	SCM_I_ARRAY_V (vra0) = SCM_I_ARRAY_V (ra0);
-      }
-    else
-      {
-	size_t length = scm_c_array_length (ra0);
-	kmax = 0;
-	SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
-	SCM_I_ARRAY_DIMS (vra0)->ubnd = length - 1;
-	SCM_I_ARRAY_DIMS (vra0)->inc = 1;
-	SCM_I_ARRAY_BASE (vra0) = 0;
-	SCM_I_ARRAY_V (vra0) = ra0;
-	ra0 = vra0;
-      }
-    lvra = SCM_EOL;
-    plvra = &lvra;
-    for (z = lra; scm_is_pair (z); z = SCM_CDR (z))
-      {
-	ra1 = SCM_CAR (z);
-	vra1 = scm_i_make_array (1);
-	SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
-	SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
-	if (SCM_I_ARRAYP (ra1))
-	  {
-	    if (kmax >= 0)
-	      SCM_I_ARRAY_DIMS (vra1)->inc = SCM_I_ARRAY_DIMS (ra1)[kmax].inc;
-	    SCM_I_ARRAY_V (vra1) = SCM_I_ARRAY_V (ra1);
-	  }
-	else
-	  {
-	    SCM_I_ARRAY_DIMS (vra1)->inc = 1;
-	    SCM_I_ARRAY_V (vra1) = ra1;
-	  }
-	*plvra = scm_cons (vra1, SCM_EOL);
-	plvra = SCM_CDRLOC (*plvra);
-      }
-
-    vinds = scm_gc_malloc_pointerless (sizeof(long) * SCM_I_ARRAY_NDIM (ra0),
-				       indices_gc_hint);
-
-    for (k = 0; k <= kmax; k++)
-      vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd;
-    k = kmax;
-    do
-      {
-	if (k == kmax)
-	  {
-	    SCM y = lra;
-	    SCM_I_ARRAY_BASE (vra0) = cind (ra0, vinds);
-	    for (z = lvra; scm_is_pair (z); z = SCM_CDR (z), y = SCM_CDR (y))
-	      SCM_I_ARRAY_BASE (SCM_CAR (z)) = cind (SCM_CAR (y), vinds);
-	    if (0 == (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra)))
-	      return 0;
-	    k--;
-	    continue;
-	  }
-	if (vinds[k] < SCM_I_ARRAY_DIMS (ra0)[k].ubnd)
-	  {
-	    vinds[k]++;
-	    k++;
-	    continue;
-	  }
-	vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd - 1;
-	k--;
-      }
-    while (k >= 0);
+      if (SCM_I_ARRAYP (ra0))
+        {
+          kmax = SCM_I_ARRAY_NDIM (ra0) - 1;
+          if (kmax < 0)
+            {
+              SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
+              SCM_I_ARRAY_DIMS (vra0)->ubnd = 0;
+              SCM_I_ARRAY_DIMS (vra0)->inc = 1;
+            }
+          else
+            {
+              SCM_I_ARRAY_DIMS (vra0)->lbnd = SCM_I_ARRAY_DIMS (ra0)[kmax].lbnd;
+              SCM_I_ARRAY_DIMS (vra0)->ubnd = SCM_I_ARRAY_DIMS (ra0)[kmax].ubnd;
+              SCM_I_ARRAY_DIMS (vra0)->inc = SCM_I_ARRAY_DIMS (ra0)[kmax].inc;
+            }
+          SCM_I_ARRAY_BASE (vra0) = SCM_I_ARRAY_BASE (ra0);
+          SCM_I_ARRAY_V (vra0) = SCM_I_ARRAY_V (ra0);
+        }
+      else
+        {
+          kmax = 0;
+          ra0 = vra0 = make1array(ra0);
+        }
+      lvra = SCM_EOL;
+      plvra = &lvra;
+      for (z = lra; !scm_is_null (z); z = SCM_CDR (z))
+        {
+          SCM ra1 = SCM_CAR (z);
+          SCM vra1 = scm_i_make_array (1);
+          SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
+          SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
+          if (SCM_I_ARRAYP (ra1))
+            {
+              if (kmax >= 0)
+                SCM_I_ARRAY_DIMS (vra1)->inc = SCM_I_ARRAY_DIMS (ra1)[kmax].inc;
+              SCM_I_ARRAY_V (vra1) = SCM_I_ARRAY_V (ra1);
+            }
+          else
+            {
+              SCM_I_ARRAY_DIMS (vra1)->inc = 1;
+              SCM_I_ARRAY_V (vra1) = ra1;
+            }
+          *plvra = scm_cons (vra1, SCM_EOL);
+          plvra = SCM_CDRLOC (*plvra);
+        }
+
+      vinds = scm_gc_malloc_pointerless (sizeof(long) * SCM_I_ARRAY_NDIM (ra0),
+                                         indices_gc_hint);
 
-    case 5:
-    return 1;
+      for (k = 0; k <= kmax; k++)
+        vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd;
+      k = kmax;
+      do
+        {
+          if (k == kmax)
+            {
+              SCM y = lra;
+              SCM_I_ARRAY_BASE (vra0) = cind (ra0, vinds);
+              for (z = lvra; !scm_is_null (z); z = SCM_CDR (z), y = SCM_CDR (y))
+                SCM_I_ARRAY_BASE (SCM_CAR (z)) = cind (SCM_CAR (y), vinds);
+              if (0 == (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra)))
+                return 0;
+              k--;
+              continue;
+            }
+          if (vinds[k] < SCM_I_ARRAY_DIMS (ra0)[k].ubnd)
+            {
+              vinds[k]++;
+              k++;
+              continue;
+            }
+          vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd - 1;
+          k--;
+        }
+      while (k >= 0);
+
+      return 1;
     }
 }