diff options
Diffstat (limited to 'libguile')
| -rw-r--r-- | libguile/quicksort.i.c | 48 | ||||
| -rw-r--r-- | libguile/sort.c | 68 |
2 files changed, 62 insertions, 54 deletions
diff --git a/libguile/quicksort.i.c b/libguile/quicksort.i.c index cf1742efa..598267268 100644 --- a/libguile/quicksort.i.c +++ b/libguile/quicksort.i.c @@ -27,7 +27,7 @@ reduces the probability of selecting a bad pivot value and eliminates certain extraneous comparisons. - 3. Only quicksorts NR_ELEMS / MAX_THRESH partitions, leaving insertion sort + 3. Only quicksorts (UBND-LBND+1) / MAX_THRESH partitions, leaving insertion sort to order the MAX_THRESH items within each partition. This is a big win, since insertion sort is faster for small, mostly sorted array segments. @@ -54,33 +54,29 @@ #define STACK_NOT_EMPTY (stack < top) static void -NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) +NAME (VEC_PARAM ssize_t lbnd, ssize_t ubnd, INC_PARAM SCM less) { /* Stack node declarations used to store unfulfilled partition obligations. */ typedef struct { - size_t lo; - size_t hi; + ssize_t lo; + ssize_t hi; } stack_node; static const char s_buggy_less[] = "buggy less predicate used when sorting"; - if (nr_elems == 0) - /* Avoid lossage with unsigned arithmetic below. */ - return; - - if (nr_elems > MAX_THRESH) + if (ubnd-lbnd+1 > MAX_THRESH) { - size_t lo = 0; - size_t hi = nr_elems-1; + ssize_t lo = lbnd; + ssize_t hi = ubnd; stack_node stack[STACK_SIZE]; stack_node *top = stack + 1; while (STACK_NOT_EMPTY) { - size_t left; - size_t right; - size_t mid = lo + (hi - lo) / 2; + ssize_t left; + ssize_t right; + ssize_t mid = lo + (hi - lo) / 2; SCM pivot; /* Select median value from among LO, MID, and HI. Rearrange @@ -145,16 +141,16 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) ignore one or both. Otherwise, push the larger partition's bounds on the stack and continue sorting the smaller one. */ - if ((size_t) (right - lo) <= MAX_THRESH) + if ((right - lo) <= MAX_THRESH) { - if ((size_t) (hi - left) <= MAX_THRESH) + if ((hi - left) <= MAX_THRESH) /* Ignore both small partitions. */ POP (lo, hi); else /* Ignore small left partition. */ lo = left; } - else if ((size_t) (hi - left) <= MAX_THRESH) + else if ((hi - left) <= MAX_THRESH) /* Ignore small right partition. */ hi = right; else if ((right - lo) > (hi - left)) @@ -179,10 +175,10 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) one beyond it!). */ { - size_t tmp = 0; - size_t end = nr_elems-1; - size_t thresh = min (end, MAX_THRESH); - size_t run; + ssize_t tmp = lbnd; + ssize_t end = ubnd; + ssize_t thresh = min (end, MAX_THRESH); + ssize_t run; /* Find smallest element in first threshold and place it at the array's beginning. This is the smallest array element, @@ -192,12 +188,12 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) if (scm_is_true (scm_call_2 (less, GET(run), GET(tmp)))) tmp = run; - if (tmp != 0) - SWAP (tmp, 0); + if (tmp != lbnd) + SWAP (tmp, lbnd); /* Insertion sort, running from left-hand-side up to right-hand-side. */ - run = 1; + run = lbnd + 1; while (++run <= end) { SCM_TICK; @@ -206,7 +202,7 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) while (scm_is_true (scm_call_2 (less, GET(run), GET(tmp)))) { /* The comparison predicate may be buggy */ - if (tmp == 0) + if (tmp == lbnd) scm_misc_error (NULL, s_buggy_less, SCM_EOL); tmp -= 1; @@ -216,7 +212,7 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) if (tmp != run) { SCM to_insert = GET(run); - size_t hi, lo; + ssize_t hi, lo; for (hi = lo = run; --lo >= tmp; hi = lo) SET(hi, GET(lo)); 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.") |