mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 23:00:22 +02:00
Code Activity

(scm_array_index_map_x): First test for real arrays,

Browse source 
then check for generalized vectors.  This ensures that the
generalized vector case need only work with zero-origin ranges.
This commit is contained in:
Marius Vollmer 2005-06-12 12:52:59 +00:00
parent fc4abd0e6a
commit 5ead53fc4e
1 changed files with 9 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

18
libguile/ramap.c
View file

@ -986,14 +986,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
unsigned long i; unsigned long i;
SCM_VALIDATE_PROC (2, proc); SCM_VALIDATE_PROC (2, proc);
if (scm_is_generalized_vector (ra)) if (SCM_I_ARRAYP (ra))
{
size_t length = scm_c_generalized_vector_length (ra);
for (i = 0; i < length; i++)
GVSET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
return SCM_UNSPECIFIED;
}
else if (SCM_I_ARRAYP (ra))
{ {
SCM args = SCM_EOL; SCM args = SCM_EOL;
int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1; int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
@ -1040,7 +1033,14 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
scm_frame_end (); scm_frame_end ();
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
else else if (scm_is_generalized_vector (ra))
{
size_t length = scm_c_generalized_vector_length (ra);
for (i = 0; i < length; i++)
GVSET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
return SCM_UNSPECIFIED;
}
else
scm_wrong_type_arg_msg (NULL, 0, ra, "array"); scm_wrong_type_arg_msg (NULL, 0, ra, "array");
} }
#undef FUNC_NAME #undef FUNC_NAME