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

(scm_array_in_bounds_p): First test for real arrays, then

Browse source 
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-06 17:21:26 +00:00
parent 10bb867973
commit cb5773fe72
1 changed files with 16 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

28
libguile/unif.c
View file

@ -1136,18 +1136,7 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);
if (scm_is_generalized_vector (v)) if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
{
long ind;
if (!scm_is_pair (args))
SCM_WRONG_NUM_ARGS ();
ind = scm_to_long (SCM_CAR (args));
args = SCM_CDR (args);
res = scm_from_bool (ind >= 0
&& ind < scm_c_generalized_vector_length (v));
}
else if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
{ {
size_t k = SCM_I_ARRAY_NDIM (v); size_t k = SCM_I_ARRAY_NDIM (v);
scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v); scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
@ -1172,6 +1161,21 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
} }
} }
} }
else if (scm_is_generalized_vector (v))
{
/* Since real arrays have been covered above, all generalized
vectors are guaranteed to be zero-origin here.
*/
long ind;
if (!scm_is_pair (args))
SCM_WRONG_NUM_ARGS ();
ind = scm_to_long (SCM_CAR (args));
args = SCM_CDR (args);
res = scm_from_bool (ind >= 0
&& ind < scm_c_generalized_vector_length (v));
}
else else
scm_wrong_type_arg_msg (NULL, 0, v, "array"); scm_wrong_type_arg_msg (NULL, 0, v, "array");