diff options
Diffstat (limited to 'libguile/sort.c')
| -rw-r--r-- | libguile/sort.c | 68 |
1 files changed, 40 insertions, 28 deletions
diff --git a/libguile/sort.c b/libguile/sort.c index 81ef3ff27..ff7d6634d 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -69,7 +69,7 @@ #define SET(i, val) scm_array_handle_set (ra, scm_array_handle_pos_1 (ra, i), val) #include "libguile/quicksort.i.c" -SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, +SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, (SCM vec, SCM less, SCM startpos, SCM endpos), "Sort the vector @var{vec}, using @var{less} for comparing\n" "the vector elements. @var{startpos} (inclusively) and\n" @@ -79,7 +79,7 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, #define FUNC_NAME s_scm_restricted_vector_sort_x { ssize_t spos = scm_to_ssize_t (startpos); - size_t epos = scm_to_ssize_t (endpos); + ssize_t epos = scm_to_ssize_t (endpos)-1; scm_t_array_handle handle; scm_t_array_dim const * dims; @@ -89,26 +89,25 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, if (scm_array_handle_rank(&handle) != 1) { scm_array_handle_release (&handle); - scm_error (scm_misc_error_key, FUNC_NAME, "rank must be 1", vec, SCM_EOL); + scm_misc_error (FUNC_NAME, "rank must be 1", scm_list_1 (vec)); } if (spos < dims[0].lbnd) { scm_array_handle_release (&handle); - scm_error (scm_out_of_range_key, FUNC_NAME, "startpos out of range", - vec, scm_list_1(startpos)); + scm_error (scm_out_of_range_key, FUNC_NAME, "startpos ~s out of range of ~s", + scm_list_2 (startpos, vec), scm_list_1 (startpos)); } - if (epos > dims[0].ubnd+1) + if (epos > dims[0].ubnd) { scm_array_handle_release (&handle); - scm_error (scm_out_of_range_key, FUNC_NAME, "endpos out of range", - vec, scm_list_1(endpos)); + scm_error (scm_out_of_range_key, FUNC_NAME, "endpos ~s out of range of ~s", + scm_list_2 (endpos, vec), scm_list_1 (endpos)); } - if (handle.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM) - quicksort (scm_array_handle_writable_elements (&handle) + (spos-dims[0].lbnd) * dims[0].inc, - epos-spos, dims[0].inc, less); + quicksort (scm_array_handle_writable_elements (&handle) - dims[0].lbnd * dims[0].inc, + spos, epos, dims[0].inc, less); else - quicksorta (&handle, epos-spos, less); + quicksorta (&handle, spos, epos, less); scm_array_handle_release (&handle); return SCM_UNSPECIFIED; @@ -187,11 +186,11 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, } else { - for (i = dims[0].lbnd+1, end = dims[0].ubnd+1; i < end; ++i) + for (i = 1, end = dims[0].ubnd-dims[0].lbnd+1; i < end; ++i) { if (scm_is_true (scm_call_2 (less, - scm_array_handle_ref (&handle, scm_array_handle_pos_1 (&handle, i)), - scm_array_handle_ref (&handle, scm_array_handle_pos_1 (&handle, i-1))))) + scm_array_handle_ref (&handle, i*dims[0].inc), + scm_array_handle_ref (&handle, (i-1)*dims[0].inc)))) { result = SCM_BOOL_F; break; @@ -211,7 +210,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, and returns a new list in which the elements of a and b have been stably interleaved so that (sorted? (merge a b less?) less?). Note: this does _not_ accept vectors. */ -SCM_DEFINE (scm_merge, "merge", 3, 0, 0, +SCM_DEFINE (scm_merge, "merge", 3, 0, 0, (SCM alist, SCM blist, SCM less), "Merge two already sorted lists into one.\n" "Given two lists @var{alist} and @var{blist}, such that\n" @@ -275,7 +274,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, #undef FUNC_NAME -static SCM +static SCM scm_merge_list_x (SCM alist, SCM blist, long alen, long blen, SCM less) @@ -327,7 +326,7 @@ scm_merge_list_x (SCM alist, SCM blist, } /* scm_merge_list_x */ -SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, +SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, (SCM alist, SCM blist, SCM less), "Takes two lists @var{alist} and @var{blist} such that\n" "@code{(sorted? alist less?)} and @code{(sorted? blist less?)} and\n" @@ -358,7 +357,7 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, scsh's merge-sort but that algorithm showed to not be stable, even though it claimed to be. */ -static SCM +static SCM scm_merge_list_step (SCM * seq, SCM less, long n) { SCM a, b; @@ -406,7 +405,7 @@ scm_merge_list_step (SCM * seq, SCM less, long n) } while (0) -SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, +SCM_DEFINE (scm_sort_x, "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\n" @@ -427,10 +426,23 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, } else if (scm_is_array (items) && scm_c_array_rank (items) == 1) { + scm_t_array_handle handle; + scm_t_array_dim const * dims; + scm_array_get_handle (items, &handle); + dims = scm_array_handle_dims (&handle); + + if (scm_array_handle_rank (&handle) != 1) + { + scm_array_handle_release (&handle); + scm_misc_error (FUNC_NAME, "rank must be 1", scm_list_1 (items)); + } + scm_restricted_vector_sort_x (items, less, - scm_from_int (0), - scm_array_length (items)); + scm_from_ssize_t (dims[0].lbnd), + scm_from_ssize_t (dims[0].ubnd+1)); + + scm_array_handle_release (&handle); return items; } else @@ -439,7 +451,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_sort, "sort", 2, 0, 0, +SCM_DEFINE (scm_sort, "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\n" @@ -525,7 +537,7 @@ scm_merge_vector_step (SCM *vec, } /* scm_merge_vector_step */ -SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, +SCM_DEFINE (scm_stable_sort_x, "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" @@ -551,7 +563,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, SCM temp, *temp_elts, *vec_elts; size_t len; ssize_t inc; - + vec_elts = scm_vector_writable_elements (items, &vec_handle, &len, &inc); if (len == 0) @@ -559,7 +571,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, scm_array_handle_release (&vec_handle); return items; } - + temp = scm_c_make_vector (len, SCM_UNDEFINED); temp_elts = scm_vector_writable_elements (temp, &temp_handle, NULL, NULL); @@ -577,7 +589,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, #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" @@ -613,7 +625,7 @@ SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0, +SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0, (SCM items, SCM less), "Sort the list @var{items}, using @var{less} for comparing the\n" "list elements. This is a stable sort.") |