mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 09:40:25 +02:00
Code Activity

* weaks.c: Use new vector elements API or simple vector

Browse source 
API, as appropriate.

* srfi-4.h, srfi-4.c, srfi-4.i.c (scm_array_handle_uniform_elements,
scm_array_handle_uniform_writable_elements,
scm_uniform_vector_elements, scm_uniform_vector_writable_elements):
(scm_<foo>vector_elements, scm_<foo>vector_writable_elements): Use
scm_t_array_handle, deliver length and increment.
(scm_array_handle_<foo>_elements,
scm_array_handle_<foo>_writable_elements): New.

* unif.h, unif.c (scm_t_array_handle, scm_array_get_handle,
scm_array_handle_rank, scm_array_handle_dims, scm_array_handle_ref
scm_array_handle_set, scm_array_handle_elements
scm_array_handle_writable_elements, scm_vector_get_handle): New.
(scm_make_uve, scm_array_prototype, scm_list_to_uniform_array,
scm_dimensions_to_uniform_array): Deprecated for real.  (scm_array_p,
scm_i_array_p): Use latter for SCM_DEFINE since snarfing wont allow a
mismatch between C and Scheme arglists.  (scm_make_shared_array,
scm_enclose_array): Correctly use scm_c_generalized_vector_length
instead of scm_uniform_vector_length.

* weaks.h, weaks.c: Use new internal weak vector API from
vectors.h.

* Makefile.am (libguile_la_SOURCES, DOT_X_FILES, DOT_DOC_FILES,
EXTRA_libguile_la_SOURCES): Changed ramap.c and unif.c from being
'extra' to being regular sources.
(noinst_HEADERS): Added quicksort.i.c.
* quicksort.i.c: New file.

* vectors.h, vector.c (SCM_VECTORP, SCM_VECTOR_LENGTH, SCM_VELTS,
SCM_WRITABLE_VELTS, SCM_VECTOR_REF, SCM_VECTOR_SET): Deprecated and
reimplemented.  Replaced all uses with scm_vector_elements,
scm_vector_writable_elements, or SCM_SIMPLE_VECTOR_*, as appropriate.
(scm_is_simple_vector, SCM_SIMPLE_VECTOR_LENGTH,
SCM_SIMPLE_VECTOR_REF, SCM_SIMPLE_VECTOR_SET, SCM_SIMPLE_VECTOR_LOC):
New.  (SCM_VECTOR_BASE, SCM_SET_VECTOR_BASE, SCM_VECTOR_MAX_LENGTH,
SCM_MAKE_VECTOR_TAG, SCM_SET_VECTOR_LENGTH, SCM_VELTS_AS_STACKITEMS,
SCM_SETVELTS, SCM_GC_WRITABLE_VELTS): Removed.  (scm_vector_copy):
New.  (scm_vector_elements, scm_vector_writable_elements): Use
scm_t_array_handle, deliver length and increment.  Moved to
unif.h. Changed all uses.  (scm_vector_release_elements,
scm_vector_release_writable_elements,
(scm_frame_vector_release_elements,
scm_frame_vector_release_writable_elements): Removed.
(SCM_I_IS_VECTOR, SCM_I_VECTOR_ELTS, SCM_I_VECTOR_WELTS,
SCM_I_VECTOR_LENGTH, scm_i_vector_free): New internal API.
(SCM_I_WVECTP SCM_I_WVECT_LENGTH SCM_I_WVECT_VELTS
SCM_I_WVECT_GC_WVELTS SCM_I_WVECT_TYPE SCM_I_WVECT_GC_CHAIN
SCM_I_SET_WVECT_GC_CHAIN, scm_i_allocate_weak_vector): New, for weak
vectors.
This commit is contained in:
Marius Vollmer 2005-01-02 20:06:08 +00:00
parent 9c6e33c62a
commit 6e708ef2b1
9 changed files with 714 additions and 410 deletions
Download patch file Download diff file Expand all files Collapse all files

176
libguile/unif.c
View file

@ -253,6 +253,122 @@ scm_is_typed_array (SCM obj, SCM type)
return scm_is_eq (type, scm_i_generalized_vector_type (obj));
}
void
scm_array_get_handle (SCM array, scm_t_array_handle *h)
{
h->array = array;
if (SCM_ARRAYP (array) || SCM_ENCLOSED_ARRAYP (array))
{
h->dims = SCM_ARRAY_DIMS (array);
h->base = SCM_ARRAY_BASE (array);
}
else if (scm_is_generalized_vector (array))
{
h->dim0.lbnd = 0;
h->dim0.ubnd = scm_c_generalized_vector_length (array) - 1;
h->dim0.inc = 1;
h->dims = &h->dim0;
h->base = 0;
}
else
scm_wrong_type_arg_msg (NULL, 0, array, "array");
}
size_t
scm_array_handle_rank (scm_t_array_handle *h)
{
if (SCM_ARRAYP (h->array) || SCM_ENCLOSED_ARRAYP (h->array))
return SCM_ARRAY_NDIM (h->array);
else
return 1;
}
scm_t_array_dim *
scm_array_handle_dims (scm_t_array_handle *h)
{
return h->dims;
}
SCM
scm_array_handle_ref (scm_t_array_handle *h, size_t pos)
{
pos += h->base;
if (SCM_ARRAYP (h->array))
return scm_i_cvref (SCM_ARRAY_V (h->array), pos, 0);
if (SCM_ENCLOSED_ARRAYP (h->array))
return scm_i_cvref (SCM_ARRAY_V (h->array), pos, 1);
return scm_c_generalized_vector_ref (h->array, pos);
}
void
scm_array_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
{
pos += h->base;
if (SCM_ARRAYP (h->array))
scm_c_generalized_vector_set_x (SCM_ARRAY_V (h->array), pos, val);
if (SCM_ENCLOSED_ARRAYP (h->array))
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array");
scm_c_generalized_vector_set_x (h->array, pos, val);
}
const SCM *
scm_array_handle_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
if (SCM_ARRAYP (vec))
vec = SCM_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_ELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
}
SCM *
scm_array_handle_writable_elements (scm_t_array_handle *h)
{
SCM vec = h->array;
if (SCM_ARRAYP (vec))
vec = SCM_ARRAY_V (vec);
if (SCM_I_IS_VECTOR (vec))
return SCM_I_VECTOR_WELTS (vec) + h->base;
scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
}
void
scm_vector_get_handle (SCM vec, scm_t_array_handle *h)
{
scm_array_get_handle (vec, h);
if (scm_array_handle_rank (h) != 1)
scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
}
const SCM *
scm_vector_elements (SCM vec, scm_t_array_handle *h,
size_t *lenp, ssize_t *incp)
{
scm_vector_get_handle (vec, h);
if (lenp)
{
scm_t_array_dim *dim = scm_array_handle_dims (h);
*lenp = dim->ubnd - dim->lbnd + 1;
*incp = dim->inc;
}
return scm_array_handle_elements (h);
}
SCM *
scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
size_t *lenp, ssize_t *incp)
{
scm_vector_get_handle (vec, h);
if (lenp)
{
scm_t_array_dim *dim = scm_array_handle_dims (h);
*lenp = dim->ubnd - dim->lbnd + 1;
*incp = dim->inc;
}
return scm_array_handle_writable_elements (h);
}
#if SCM_ENABLE_DEPRECATED
SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
@ -281,16 +397,24 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
scm_is_array or scm_is_typed_array anyway.
*/
SCM_DEFINE (scm_array_p, "array?", 1, 0, 0,
(SCM obj, SCM unused),
static SCM scm_i_array_p (SCM obj);
SCM_DEFINE (scm_i_array_p, "array?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
"not.")
#define FUNC_NAME s_scm_array_p
#define FUNC_NAME s_scm_i_array_p
{
return scm_from_bool (scm_is_array (obj));
}
#undef FUNC_NAME
SCM
scm_array_p (SCM obj, SCM prot)
{
return scm_from_bool (scm_is_array (obj));
}
#endif /* !SCM_ENABLE_DEPRECATED */
@ -708,7 +832,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
{
SCM v = SCM_ARRAY_V (ra);
unsigned long int length = scm_to_ulong (scm_uniform_vector_length (v));
size_t length = scm_c_generalized_vector_length (v);
if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
return v;
if (s->ubnd < s->lbnd)
@ -745,7 +869,6 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
#define FUNC_NAME s_scm_transpose_array
{
SCM res, vargs;
SCM const *ve = &vargs;
scm_t_array_dim *s, *r;
int ndim, i, k;
@ -767,13 +890,13 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
if (SCM_ARRAYP (ra) || SCM_ENCLOSED_ARRAYP (ra))
{
vargs = scm_vector (args);
if (SCM_VECTOR_LENGTH (vargs) != SCM_ARRAY_NDIM (ra))
if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_ARRAY_NDIM (ra))
SCM_WRONG_NUM_ARGS ();
ve = SCM_VELTS (vargs);
ndim = 0;
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
{
i = scm_to_signed_integer (ve[k], 0, SCM_ARRAY_NDIM(ra));
i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
0, SCM_ARRAY_NDIM(ra));
if (ndim < i)
ndim = i;
}
@ -788,7 +911,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
}
for (k = SCM_ARRAY_NDIM (ra); k--;)
{
i = scm_to_int (ve[k]);
i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
s = &(SCM_ARRAY_DIMS (ra)[k]);
r = &(SCM_ARRAY_DIMS (res)[i]);
if (r->ubnd < r->lbnd)
@ -859,7 +982,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
if (scm_is_generalized_vector (ra))
{
s->lbnd = 0;
s->ubnd = scm_to_long (scm_uniform_vector_length (ra)) - 1;
s->ubnd = scm_c_generalized_vector_length (ra) - 1;
s->inc = 1;
SCM_ARRAY_V (ra_inr) = ra;
SCM_ARRAY_BASE (ra_inr) = 0;
@ -1755,23 +1878,19 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
}
else if (scm_is_true (scm_u32vector_p (kv)))
{
size_t ulen, i;
scm_t_array_handle handle;
size_t i, len;
ssize_t inc;
const scm_t_uint32 *indices;
/* assert that obj is a boolean.
*/
scm_to_bool (obj);
scm_frame_begin (0);
indices = scm_u32vector_elements (kv, &handle, &len, &inc);
for (i = 0; i < len; i++, indices += inc)
scm_c_bitvector_set_x (v, (size_t) *indices, obj);
ulen = scm_c_uniform_vector_length (kv);
indices = scm_u32vector_elements (kv);
scm_frame_uniform_vector_release_elements (kv);
for (i = 0; i < ulen; i++)
scm_c_bitvector_set_x (v, (size_t)indices[i], obj);
scm_frame_end ();
}
else
scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
@ -1833,23 +1952,20 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
}
else if (scm_is_true (scm_u32vector_p (kv)))
{
size_t count = 0, ulen, i;
size_t count = 0;
scm_t_array_handle handle;
size_t i, len;
ssize_t inc;
const scm_t_uint32 *indices;
int bit = scm_to_bool (obj);
scm_frame_begin (0);
indices = scm_u32vector_elements (kv, &handle, &len, &inc);
ulen = scm_c_uniform_vector_length (kv);
indices = scm_u32vector_elements (kv);
scm_frame_uniform_vector_release_elements (kv);
for (i = 0; i < ulen; i++)
if ((scm_is_true (scm_c_bitvector_ref (v, (size_t)indices[i])) != 0)
for (i = 0; i < len; i++, indices += inc)
if ((scm_is_true (scm_c_bitvector_ref (v, (size_t) *indices)) != 0)
== (bit != 0))
count++;
scm_frame_end ();
return scm_from_size_t (count);
}
else