diff --git a/libguile/array-map.c b/libguile/array-map.c index b05548b61..b5b8cec9e 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -716,36 +716,35 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, static int rafe (SCM ra0, SCM proc, SCM ras) { - long i = SCM_I_ARRAY_DIMS (ra0)->lbnd; - unsigned long i0 = SCM_I_ARRAY_BASE (ra0); - long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc; - long n = SCM_I_ARRAY_DIMS (ra0)->ubnd; - ra0 = SCM_I_ARRAY_V (ra0); + ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd; + size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1; + + scm_t_array_handle h0; + size_t i0, i0end; + ssize_t inc0; + scm_generalized_vector_get_handle (SCM_I_ARRAY_V (ra0), &h0); + i0 = h0.base + h0.dims[0].lbnd + SCM_I_ARRAY_BASE (ra0)*h0.dims[0].inc; + inc0 = SCM_I_ARRAY_DIMS (ra0)->inc * h0.dims[0].inc; + i0end = i0 + n*inc0; if (scm_is_null (ras)) - for (; i <= n; i++, i0 += inc0) - scm_call_1 (proc, GVREF (ra0, i0)); + for (; i0 < i0end; i0 += inc0) + scm_call_1 (proc, h0.impl->vref (&h0, i0)); else { - SCM ra1 = SCM_CAR (ras); - SCM args; - unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 = SCM_I_ARRAY_V (ra1); - ras = scm_vector (SCM_CDR (ras)); - - for (; i <= n; i++, i0 += inc0, i1 += inc1) - { - args = SCM_EOL; - for (k = scm_c_vector_length (ras); k--;) - args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args); - args = scm_cons2 (GVREF (ra0, i0), GVREF (ra1, i1), args); - scm_apply_0 (proc, args); - } + ras = scm_vector (ras); + for (; i0 < i0end; i0 += inc0, ++i) + { + SCM args = SCM_EOL; + unsigned long k; + for (k = scm_c_vector_length (ras); k--;) + args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args); + scm_apply_1 (proc, h0.impl->vref (&h0, i0), args); + } } + scm_array_handle_release (&h0); return 1; } - SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1, (SCM proc, SCM ra0, SCM lra), "Apply @var{proc} to each tuple of elements of @var{ra0} @dots{}\n"