mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00
Code Activity

Remove double indirection for 1st arg of array-for-each

Browse source 
* libguile/array-map.c: (rafe): factor GVREF out of rank-1 loop for ra0.
This commit is contained in:
Daniel Llorens 2013-04-02 16:43:37 +02:00 • committed by Ludovic Courtès
parent 3220b08049
commit c3e3ef6eb6
1 changed files with 22 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

37
libguile/array-map.c
View file

@ -716,36 +716,35 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
static int static int
rafe (SCM ra0, SCM proc, SCM ras) rafe (SCM ra0, SCM proc, SCM ras)
{ {
long i = SCM_I_ARRAY_DIMS (ra0)->lbnd; ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
unsigned long i0 = SCM_I_ARRAY_BASE (ra0); size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - i + 1;
long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
long n = SCM_I_ARRAY_DIMS (ra0)->ubnd; scm_t_array_handle h0;
ra0 = SCM_I_ARRAY_V (ra0); 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)) if (scm_is_null (ras))
for (; i <= n; i++, i0 += inc0) for (; i0 < i0end; i0 += inc0)
scm_call_1 (proc, GVREF (ra0, i0)); scm_call_1 (proc, h0.impl->vref (&h0, i0));
else else
{ {
SCM ra1 = SCM_CAR (ras); ras = scm_vector (ras);
SCM args; for (; i0 < i0end; i0 += inc0, ++i)
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; SCM args = SCM_EOL;
unsigned long k;
for (k = scm_c_vector_length (ras); k--;) for (k = scm_c_vector_length (ras); k--;)
args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args); args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
args = scm_cons2 (GVREF (ra0, i0), GVREF (ra1, i1), args); scm_apply_1 (proc, h0.impl->vref (&h0, i0), args);
scm_apply_0 (proc, args);
} }
} }
scm_array_handle_release (&h0);
return 1; return 1;
} }
SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1, SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
(SCM proc, SCM ra0, SCM lra), (SCM proc, SCM ra0, SCM lra),
"Apply @var{proc} to each tuple of elements of @var{ra0} @dots{}\n" "Apply @var{proc} to each tuple of elements of @var{ra0} @dots{}\n"