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

(scm_make_shared_array): Use it instead of scm_aind; use handle

Browse source 
for oldra.
This commit is contained in:
Marius Vollmer 2005-01-10 01:41:35 +00:00
parent d3ddc95ef1
commit 112ba0ac28
1 changed files with 16 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

45
libguile/unif.c
View file

@ -853,23 +853,27 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_make_shared_array #define FUNC_NAME s_scm_make_shared_array
{ {
scm_t_array_handle old_handle;
SCM ra; SCM ra;
SCM inds, indptr; SCM inds, indptr;
SCM imap; SCM imap;
size_t k, i; size_t k;
ssize_t i;
long old_min, new_min, old_max, new_max; long old_min, new_min, old_max, new_max;
scm_t_array_dim *s; scm_t_array_dim *s;
SCM_VALIDATE_REST_ARGUMENT (dims); SCM_VALIDATE_REST_ARGUMENT (dims);
SCM_VALIDATE_ARRAY (1, oldra);
SCM_VALIDATE_PROC (2, mapfunc); SCM_VALIDATE_PROC (2, mapfunc);
ra = scm_shap2ra (dims, FUNC_NAME); ra = scm_shap2ra (dims, FUNC_NAME);
scm_array_get_handle (oldra, &old_handle);
if (SCM_ARRAYP (oldra)) if (SCM_ARRAYP (oldra))
{ {
SCM_ARRAY_V (ra) = SCM_ARRAY_V (oldra); SCM_ARRAY_V (ra) = SCM_ARRAY_V (oldra);
old_min = old_max = SCM_ARRAY_BASE (oldra); old_min = old_max = SCM_ARRAY_BASE (oldra);
s = SCM_ARRAY_DIMS (oldra); s = scm_array_handle_dims (&old_handle);
k = SCM_ARRAY_NDIM (oldra); k = scm_array_handle_rank (&old_handle);
while (k--) while (k--)
{ {
if (s[k].inc > 0) if (s[k].inc > 0)
@ -884,6 +888,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
old_min = 0; old_min = 0;
old_max = scm_c_generalized_vector_length (oldra) - 1; old_max = scm_c_generalized_vector_length (oldra) - 1;
} }
inds = SCM_EOL; inds = SCM_EOL;
s = SCM_ARRAY_DIMS (ra); s = SCM_ARRAY_DIMS (ra);
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
@ -895,22 +900,13 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
ra = make_typed_vector (scm_array_type (ra), 0); ra = make_typed_vector (scm_array_type (ra), 0);
else else
SCM_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0); SCM_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0);
scm_array_handle_release (&old_handle);
return ra; return ra;
} }
} }
imap = scm_apply_0 (mapfunc, scm_reverse (inds)); imap = scm_apply_0 (mapfunc, scm_reverse (inds));
if (SCM_ARRAYP (oldra)) i = indices_to_pos (&old_handle, imap);
i = (size_t) scm_aind (oldra, imap, FUNC_NAME);
else
{
if (!scm_is_integer (imap))
{
if (scm_ilength (imap) != 1 || !scm_is_integer (SCM_CAR (imap)))
SCM_MISC_ERROR (s_bad_ind, SCM_EOL);
imap = SCM_CAR (imap);
}
i = scm_to_size_t (imap);
}
SCM_ARRAY_BASE (ra) = new_min = new_max = i; SCM_ARRAY_BASE (ra) = new_min = new_max = i;
indptr = inds; indptr = inds;
k = SCM_ARRAY_NDIM (ra); k = SCM_ARRAY_NDIM (ra);
@ -920,19 +916,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
{ {
SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1))); SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1)));
imap = scm_apply_0 (mapfunc, scm_reverse (inds)); imap = scm_apply_0 (mapfunc, scm_reverse (inds));
if (SCM_ARRAYP (oldra)) s[k].inc = indices_to_pos (&old_handle, imap) - i;
s[k].inc = scm_aind (oldra, imap, FUNC_NAME) - i;
else
{
if (!scm_is_integer (imap))
{
if (scm_ilength (imap) != 1 || !scm_is_integer (SCM_CAR (imap)))
SCM_MISC_ERROR (s_bad_ind, SCM_EOL);
imap = SCM_CAR (imap);
}
s[k].inc = scm_to_long (imap) - i;
}
i += s[k].inc; i += s[k].inc;
if (s[k].inc > 0) if (s[k].inc > 0)
new_max += (s[k].ubnd - s[k].lbnd) * s[k].inc; new_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
@ -943,6 +927,9 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
s[k].inc = new_max - new_min + 1; /* contiguous by default */ s[k].inc = new_max - new_min + 1; /* contiguous by default */
indptr = SCM_CDR (indptr); indptr = SCM_CDR (indptr);
} }
scm_array_handle_release (&old_handle);
if (old_min > new_min || old_max < new_max) if (old_min > new_min || old_max < new_max)
SCM_MISC_ERROR ("mapping out of range", SCM_EOL); SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))