Factor out make1array() in scm_ramapc()

[bpt/guile.git] / libguile / array-map.c

diff --git a/libguile/array-map.c b/libguile/array-map.c
index c297fe5..dd2fb97 100644 (file)
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -139,6 +139,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
@@ -151,7 +164,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;
@@ -172,22 +185,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))
@@ -231,21 +235,15 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
         }
       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;
+          ra0 = vra0 = make1array(ra0);
         }
       lvra = SCM_EOL;
       plvra = &lvra;
-      for (z = lra; scm_is_pair (z); z = SCM_CDR (z))
+      for (z = lra; !scm_is_null (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))
@@ -275,7 +273,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
             {
               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))
+              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;