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

Avoid per-element cons for 1-arg case of array-map!

Browse source 
* libguile/array-map.c: (ramap): special case when ras is a 1-element list.
This commit is contained in:
Daniel Llorens 2013-04-02 15:23:55 +02:00 • committed by Ludovic Courtès
parent 75a1b26c5d
commit 9a68d7b388
1 changed files with 26 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

45
libguile/array-map.c
View file

@ -643,31 +643,38 @@ scm_array_identity (SCM dst, SCM src)
static int static int
ramap (SCM ra0, SCM proc, SCM ras) ramap (SCM ra0, SCM proc, SCM ras)
{ {
long i = SCM_I_ARRAY_DIMS (ra0)->lbnd; ssize_t i = SCM_I_ARRAY_DIMS (ra0)->lbnd;
long inc = SCM_I_ARRAY_DIMS (ra0)->inc;
long n = SCM_I_ARRAY_DIMS (ra0)->ubnd; size_t i0 = SCM_I_ARRAY_BASE (ra0);
long base = SCM_I_ARRAY_BASE (ra0) - i * inc; ssize_t inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
size_t i0end = i0 + n*inc0;
ra0 = SCM_I_ARRAY_V (ra0); ra0 = SCM_I_ARRAY_V (ra0);
if (scm_is_null (ras)) if (scm_is_null (ras))
for (; i <= n; i++) for (; i0 < i0end; i0 += inc0)
GVSET (ra0, i*inc+base, scm_call_0 (proc)); GVSET (ra0, i0, scm_call_0 (proc));
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM args; size_t i1 = SCM_I_ARRAY_BASE (ra1);
unsigned long k, i1 = SCM_I_ARRAY_BASE (ra1); ssize_t inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_I_ARRAY_V (ra1); ra1 = SCM_I_ARRAY_V (ra1);
ras = scm_vector (SCM_CDR (ras)); ras = SCM_CDR (ras);
if (scm_is_null(ras))
for (; i <= n; i++, i1 += inc1) for (; i0 < i0end; i0 += inc0, i1 += inc1)
{ GVSET (ra0, i0, scm_call_1 (proc, GVREF (ra1, i1)));
args = SCM_EOL; else
for (k = scm_c_vector_length (ras); k--;) {
args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args); ras = scm_vector (ras);
args = scm_cons (GVREF (ra1, i1), args); for (; i0 < i0end; i0 += inc0, i1 += inc1, ++i)
GVSET (ra0, i*inc+base, scm_apply_0 (proc, args)); {
} 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);
GVSET (ra0, i0, scm_apply_1 (proc, GVREF (ra1, i1), args));
}
}
} }
return 1; return 1;
} }