mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Factor out make1array() in scm_ramapc()

Browse source 
* libguile/array-map.c: (scm_ramapc): factor out vector->array conversion
  to aux function make1array.
This commit is contained in:
Daniel Llorens 2013-04-19 16:44:48 +02:00 • committed by Andy Wingo
parent 35f45ed6d0
commit 2a8688a9d1
1 changed files with 22 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

46
libguile/array-map.c
View file

@ -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;