diff options
Diffstat (limited to 'libguile/array-map.c')
-rw-r--r-- | libguile/array-map.c | 46 |
1 files changed, 22 insertions, 24 deletions
diff --git a/libguile/array-map.c b/libguile/array-map.c index c297fe553..dd2fb9715 100644 --- 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; |