-/* Copyright (C) 1999,2000,2001,2002, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1999, 2000, 2001, 2002, 2004, 2006, 2007, 2008, 2009,
+ * 2010, 2011, 2012, 2014 Free Software Foundation, Inc.
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
#include "libguile/array-map.h"
#include "libguile/feature.h"
#include "libguile/vectors.h"
-#include "libguile/lang.h"
#include "libguile/async.h"
#include "libguile/dynwind.h"
#define INC inc
#include "libguile/quicksort.i.c"
-static scm_t_trampoline_2
-compare_function (SCM less, unsigned int arg_nr, const char* fname)
-{
- const scm_t_trampoline_2 cmp = scm_trampoline_2 (less);
- SCM_ASSERT_TYPE (cmp != NULL, less, arg_nr, fname, "less predicate");
- return cmp;
-}
-
SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
(SCM vec, SCM less, SCM startpos, SCM endpos),
"is not specified.")
#define FUNC_NAME s_scm_restricted_vector_sort_x
{
- const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
size_t vlen, spos, len;
ssize_t vinc;
scm_t_array_handle handle;
len = scm_to_unsigned_integer (endpos, spos, vlen) - spos;
if (vinc == 1)
- quicksort1 (velts + spos*vinc, len, cmp, less);
+ quicksort1 (velts + spos*vinc, len, less);
else
- quicksort (velts + spos*vinc, len, vinc, cmp, less);
+ quicksort (velts + spos*vinc, len, vinc, less);
scm_array_handle_release (&handle);
* (not (less? (list-ref list i) (list-ref list (- i 1)))). */
SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
(SCM items, SCM less),
- "Return @code{#t} iff @var{items} is a list or a vector such that\n"
- "for all 1 <= i <= m, the predicate @var{less} returns true when\n"
- "applied to all elements i - 1 and i")
+ "Return @code{#t} iff @var{items} is a list or vector such that, "
+ "for each element @var{x} and the next element @var{y} of "
+ "@var{items}, @code{(@var{less} @var{y} @var{x})} returns "
+ "@code{#f}.")
#define FUNC_NAME s_scm_sorted_p
{
- const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len, j; /* list/vector length, temp j */
SCM item, rest; /* rest of items loop variable */
j = len - 1;
while (j > 0)
{
- if (scm_is_true ((*cmp) (less, SCM_CAR (rest), item)))
+ if (scm_is_true (scm_call_2 (less, SCM_CAR (rest), item)))
return SCM_BOOL_F;
else
{
for (i = 1; i < len; i++, elts += inc)
{
- if (scm_is_true ((*cmp) (less, elts[inc], elts[0])))
+ if (scm_is_true (scm_call_2 (less, elts[inc], elts[0])))
{
result = SCM_BOOL_F;
break;
return alist;
else
{
- const scm_t_trampoline_2 cmp = compare_function (less, 3, FUNC_NAME);
long alen, blen; /* list lengths */
SCM last;
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen);
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen);
- if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
+ if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
build = scm_cons (SCM_CAR (blist), SCM_EOL);
blist = SCM_CDR (blist);
while ((alen > 0) && (blen > 0))
{
SCM_TICK;
- if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
+ if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
SCM_SETCDR (last, scm_cons (SCM_CAR (blist), SCM_EOL));
blist = SCM_CDR (blist);
static SCM
scm_merge_list_x (SCM alist, SCM blist,
long alen, long blen,
- scm_t_trampoline_2 cmp, SCM less)
+ SCM less)
{
SCM build, last;
return alist;
else
{
- if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
+ if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
build = blist;
blist = SCM_CDR (blist);
while ((alen > 0) && (blen > 0))
{
SCM_TICK;
- if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
+ if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
SCM_SETCDR (last, blist);
blist = SCM_CDR (blist);
return alist;
else
{
- const scm_t_trampoline_2 cmp = compare_function (less, 3, FUNC_NAME);
long alen, blen; /* list lengths */
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen);
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen);
- return scm_merge_list_x (alist, blist, alen, blen, cmp, less);
+ return scm_merge_list_x (alist, blist, alen, blen, less);
}
}
#undef FUNC_NAME
though it claimed to be.
*/
static SCM
-scm_merge_list_step (SCM * seq, scm_t_trampoline_2 cmp, SCM less, long n)
+scm_merge_list_step (SCM * seq, SCM less, long n)
{
SCM a, b;
{
long mid = n / 2;
SCM_TICK;
- a = scm_merge_list_step (seq, cmp, less, mid);
- b = scm_merge_list_step (seq, cmp, less, n - mid);
- return scm_merge_list_x (a, b, mid, n - mid, cmp, less);
+ a = scm_merge_list_step (seq, less, mid);
+ b = scm_merge_list_step (seq, less, n - mid);
+ return scm_merge_list_x (a, b, mid, n - mid, less);
}
else if (n == 2)
{
SCM y = SCM_CAR (SCM_CDR (*seq));
*seq = SCM_CDR (rest);
SCM_SETCDR (rest, SCM_EOL);
- if (scm_is_true ((*cmp) (less, y, x)))
+ if (scm_is_true (scm_call_2 (less, y, x)))
{
SCM_SETCAR (p, y);
SCM_SETCAR (rest, x);
if (scm_is_pair (items))
{
- const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
- return scm_merge_list_step (&items, cmp, less, len);
+ return scm_merge_list_step (&items, less, len);
}
- else if (scm_is_vector (items))
+ else if (scm_is_array (items) && scm_c_array_rank (items) == 1)
{
scm_restricted_vector_sort_x (items,
less,
scm_from_int (0),
- scm_vector_length (items));
+ scm_array_length (items));
return items;
}
else
if (scm_is_pair (items))
return scm_sort_x (scm_list_copy (items), less);
- else if (scm_is_vector (items))
+ else if (scm_is_array (items) && scm_c_array_rank (items) == 1)
return scm_sort_x (scm_vector_copy (items), less);
else
SCM_WRONG_TYPE_ARG (1, items);
static void
scm_merge_vector_x (SCM *vec,
SCM *temp,
- scm_t_trampoline_2 cmp,
SCM less,
size_t low,
size_t mid,
/* Copy while both segments contain more characters */
for (it = low; (i1 <= mid) && (i2 <= high); ++it)
{
- if (scm_is_true ((*cmp) (less, VEC(i2), VEC(i1))))
+ if (scm_is_true (scm_call_2 (less, VEC(i2), VEC(i1))))
temp[it] = VEC(i2++);
else
temp[it] = VEC(i1++);
static void
scm_merge_vector_step (SCM *vec,
SCM *temp,
- scm_t_trampoline_2 cmp,
SCM less,
size_t low,
size_t high,
{
size_t mid = (low + high) / 2;
SCM_TICK;
- scm_merge_vector_step (vec, temp, cmp, less, low, mid, inc);
- scm_merge_vector_step (vec, temp, cmp, less, mid+1, high, inc);
- scm_merge_vector_x (vec, temp, cmp, less, low, mid, high, inc);
+ scm_merge_vector_step (vec, temp, less, low, mid, inc);
+ scm_merge_vector_step (vec, temp, less, mid+1, high, inc);
+ scm_merge_vector_x (vec, temp, less, low, mid, high, inc);
}
} /* scm_merge_vector_step */
"This is a stable sort.")
#define FUNC_NAME s_scm_stable_sort_x
{
- const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len; /* list/vector length */
if (SCM_NULL_OR_NIL_P (items))
if (scm_is_pair (items))
{
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
- return scm_merge_list_step (&items, cmp, less, len);
+ return scm_merge_list_step (&items, less, len);
}
- else if (scm_is_vector (items))
+ else if (scm_is_array (items) && 1 == scm_c_array_rank (items))
{
scm_t_array_handle temp_handle, vec_handle;
SCM temp, *temp_elts, *vec_elts;
vec_elts = scm_vector_writable_elements (items, &vec_handle,
&len, &inc);
+ if (len == 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);
- scm_merge_vector_step (vec_elts, temp_elts, cmp, less, 0, len-1, inc);
+ scm_merge_vector_step (vec_elts, temp_elts, less, 0, len-1, inc);
scm_array_handle_release (&temp_handle);
scm_array_handle_release (&vec_handle);
if (scm_is_pair (items))
return scm_stable_sort_x (scm_list_copy (items), less);
- else if (scm_is_vector (items))
- return scm_stable_sort_x (scm_vector_copy (items), less);
else
- SCM_WRONG_TYPE_ARG (1, items);
+ return scm_stable_sort_x (scm_vector_copy (items), less);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0,
+SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0,
(SCM items, SCM less),
"Sort the list @var{items}, using @var{less} for comparing the\n"
"list elements. The sorting is destructive, that means that the\n"
"This is a stable sort.")
#define FUNC_NAME s_scm_sort_list_x
{
- const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len;
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
- return scm_merge_list_step (&items, cmp, less, len);
+ return scm_merge_list_step (&items, less, len);
}
#undef FUNC_NAME
"list elements. This is a stable sort.")
#define FUNC_NAME s_scm_sort_list
{
- const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len;
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
items = scm_list_copy (items);
- return scm_merge_list_step (&items, cmp, less, len);
+ return scm_merge_list_step (&items, less, len);
}
#undef FUNC_NAME
HCoop / bpt / guile.git / blobdiff