diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2013-04-12 15:04:52 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-01-27 21:45:18 +0100 |
commit | ba7e018b614f0964961dd14c877646d385da3a31 (patch) | |
tree | 3df2023b294f351c432071bfc167782e68928dfb | |
parent | 766f399d3b1a93e5c53768e5033de225b21aa6e1 (diff) | |
download | guile-ba7e018b614f0964961dd14c877646d385da3a31.tar.gz |
Match uniform_vector_elements with vector_elements
* libguile/vectors.c
- (scm_vector_writable_elements): allow any non-uniform rank 1 array,
after the doc. Match the implementation with scm_uniform_vector_elements.
- (scm_vector_elements): after the above.
* libguile/uniform.c
- (scm_uniform_vector_writable_elements): ditto for uniform rank 1 arrays.
* libguile/sort.c
- revert the changes in 7a6fd9, except for the argument type test; allow
what scm_vector_(writable_)elements allows.
-rw-r--r-- | libguile/sort.c | 57 | ||||
-rw-r--r-- | libguile/uniform.c | 24 | ||||
-rw-r--r-- | libguile/vectors.c | 30 |
3 files changed, 43 insertions, 68 deletions
diff --git a/libguile/sort.c b/libguile/sort.c index 1b47afcbd..0dd8c8c94 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -77,25 +77,18 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, #define FUNC_NAME s_scm_restricted_vector_sort_x { size_t vlen, spos, len; + ssize_t vinc; scm_t_array_handle handle; - scm_t_array_dim *dim; - SCM *velts; - if (!scm_is_array (vec) || 1 != scm_c_array_rank (vec)) - SCM_WRONG_TYPE_ARG (1, vec); - - scm_array_get_handle (vec, &handle); - velts = scm_array_handle_writable_elements (&handle); - dim = scm_array_handle_dims (&handle); - vlen = dim->ubnd - dim->lbnd + 1; + velts = scm_vector_writable_elements (vec, &handle, &vlen, &vinc); spos = scm_to_unsigned_integer (startpos, 0, vlen); len = scm_to_unsigned_integer (endpos, spos, vlen) - spos; - if (dim->inc == 1) - quicksort1 (velts + spos, len, less); + if (vinc == 1) + quicksort1 (velts + spos*vinc, len, less); else - quicksort (velts + spos*dim->inc, len, dim->inc, less); + quicksort (velts + spos*vinc, len, vinc, less); scm_array_handle_release (&handle); @@ -151,25 +144,19 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, size_t i, len; ssize_t inc; const SCM *elts; - SCM result = SCM_BOOL_T; elts = scm_vector_elements (items, &handle, &len, &inc); - for (i = 1; i < len; i++, elts += inc) { if (scm_is_true (scm_call_2 (less, elts[inc], elts[0]))) { - result = SCM_BOOL_F; - break; + scm_array_handle_release (&handle); + return SCM_BOOL_F; } } - scm_array_handle_release (&handle); - - return result; + return SCM_BOOL_T; } - - return SCM_BOOL_F; } #undef FUNC_NAME @@ -496,40 +483,36 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, SCM_VALIDATE_LIST_COPYLEN (1, items, len); return scm_merge_list_step (&items, less, len); } - else if (scm_is_array (items) && 1 == scm_c_array_rank (items)) + else { - scm_t_array_handle temp_handle, items_handle; - scm_t_array_dim *dim; - SCM temp, *temp_elts, *items_elts; + scm_t_array_handle temp_handle, vec_handle; + SCM temp, *temp_elts, *vec_elts; size_t len; + ssize_t inc; - scm_array_get_handle (items, &items_handle); - items_elts = scm_array_handle_writable_elements (&items_handle); - dim = scm_array_handle_dims (&items_handle); - len = dim->ubnd - dim->lbnd + 1; + vec_elts = scm_vector_writable_elements (items, &vec_handle, + &len, &inc); if (len == 0) { - scm_array_handle_release (&items_handle); + scm_array_handle_release (&vec_handle); return items; } temp = scm_c_make_vector (len, SCM_UNDEFINED); - scm_array_get_handle (temp, &temp_handle); - temp_elts = scm_array_handle_writable_elements (&temp_handle); + temp_elts = scm_vector_writable_elements (temp, &temp_handle, + NULL, NULL); - scm_merge_vector_step (items_elts, temp_elts, less, 0, len-1, dim->inc); + scm_merge_vector_step (vec_elts, temp_elts, less, 0, len-1, inc); scm_array_handle_release (&temp_handle); - scm_array_handle_release (&items_handle); + scm_array_handle_release (&vec_handle); return items; } - else - SCM_WRONG_TYPE_ARG (1, items); } #undef FUNC_NAME -SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, +SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, (SCM items, SCM less), "Sort the sequence @var{items}, which may be a list or a\n" "vector. @var{less} is used for comparing the sequence elements.\n" diff --git a/libguile/uniform.c b/libguile/uniform.c index 0be344d94..e6fcb531a 100644 --- a/libguile/uniform.c +++ b/libguile/uniform.c @@ -234,22 +234,14 @@ SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0, } #undef FUNC_NAME -const void * -scm_uniform_vector_elements (SCM uvec, - scm_t_array_handle *h, - size_t *lenp, ssize_t *incp) -{ - return scm_uniform_vector_writable_elements (uvec, h, lenp, incp); -} - void * scm_uniform_vector_writable_elements (SCM uvec, scm_t_array_handle *h, size_t *lenp, ssize_t *incp) { - void *ret; - if (!scm_is_uniform_vector (uvec)) - scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector"); + void * ret; + if (!scm_is_array (uvec) || 1 != scm_c_array_rank (uvec)) + scm_wrong_type_arg_msg (NULL, 0, uvec, "rank 1 uniform array"); scm_array_get_handle (uvec, h); /* FIXME nonlocal exit */ ret = scm_array_handle_uniform_writable_elements (h); @@ -262,7 +254,15 @@ scm_uniform_vector_writable_elements (SCM uvec, return ret; } -SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, +const void * +scm_uniform_vector_elements (SCM uvec, + scm_t_array_handle *h, + size_t *lenp, ssize_t *incp) +{ + return scm_uniform_vector_writable_elements (uvec, h, lenp, incp); +} + +SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, (SCM v), "Return the number of elements in the uniform vector @var{v}.") #define FUNC_NAME s_scm_uniform_vector_length diff --git a/libguile/vectors.c b/libguile/vectors.c index ce76de9b0..de6c9271c 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -56,23 +56,6 @@ scm_is_simple_vector (SCM obj) return SCM_I_IS_VECTOR (obj); } -const SCM * -scm_vector_elements (SCM vec, scm_t_array_handle *h, - size_t *lenp, ssize_t *incp) -{ - if (SCM_I_WVECTP (vec)) - scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector"); - - scm_generalized_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) @@ -80,7 +63,9 @@ scm_vector_writable_elements (SCM vec, scm_t_array_handle *h, if (SCM_I_WVECTP (vec)) scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector"); - scm_generalized_vector_get_handle (vec, h); + if (!scm_is_array (vec) || 1 != scm_c_array_rank (vec)) + scm_wrong_type_arg_msg (NULL, 0, vec, "rank 1 array"); + scm_array_get_handle (vec, h); if (lenp) { scm_t_array_dim *dim = scm_array_handle_dims (h); @@ -90,7 +75,14 @@ scm_vector_writable_elements (SCM vec, scm_t_array_handle *h, return scm_array_handle_writable_elements (h); } -SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, +const SCM * +scm_vector_elements (SCM vec, scm_t_array_handle *h, + size_t *lenp, ssize_t *incp) +{ + return scm_vector_writable_elements (vec, h, lenp, incp); +} + +SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, (SCM obj), "Return @code{#t} if @var{obj} is a vector, otherwise return\n" "@code{#f}.") |