[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r117765: Add vectors support to Fsort.
From: |
Dmitry Antipov |
Subject: |
[Emacs-diffs] trunk r117765: Add vectors support to Fsort. |
Date: |
Fri, 29 Aug 2014 07:31:25 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 117765
revision-id: address@hidden
parent: address@hidden
committer: Dmitry Antipov <address@hidden>
branch nick: trunk
timestamp: Fri 2014-08-29 11:29:47 +0400
message:
Add vectors support to Fsort.
* configure.ac (AC_CHECK_FUNCS): Check for qsort_r.
* src/fns.c (sort_vector, sort_vector_compare): New functions.
(sort_list): Likewise, refactored out of ...
(Fsort): ... adjusted user. Mention vectors in docstring.
(sort_vector_predicate) [!HAVE_QSORT_R]: New variable.
* src/alloc.c (make_save_int_obj): New function.
* src/lisp.h (enum Lisp_Save_Type): New member SAVE_TYPE_INT_OBJ.
(make_save_int_obj): Add prototype.
* test/automated/fns-tests.el (fns-tests-sort): New test.
modified:
ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1538
configure.ac
configure.in-20091113204419-o5vbwnq5f7feedwu-783
src/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1438
src/alloc.c alloc.c-20091113204419-o5vbwnq5f7feedwu-252
src/fns.c fns.c-20091113204419-o5vbwnq5f7feedwu-203
src/lisp.h lisp.h-20091113204419-o5vbwnq5f7feedwu-253
test/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-8588
test/automated/fns-tests.el fnstests.el-20140515083159-ls2r7gfl9o74ajzm-1
=== modified file 'ChangeLog'
--- a/ChangeLog 2014-08-28 14:48:02 +0000
+++ b/ChangeLog 2014-08-29 07:29:47 +0000
@@ -1,3 +1,7 @@
+2014-08-29 Dmitry Antipov <address@hidden>
+
+ * configure.ac (AC_CHECK_FUNCS): Check for qsort_r.
+
2014-08-28 Ken Brown <address@hidden>
* configure.ac (HYBRID_MALLOC): New macro; define to use gmalloc
=== modified file 'configure.ac'
--- a/configure.ac 2014-08-28 14:48:02 +0000
+++ b/configure.ac 2014-08-29 07:29:47 +0000
@@ -3573,7 +3573,7 @@
getrlimit setrlimit shutdown getaddrinfo \
pthread_sigmask strsignal setitimer \
sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \
-gai_strerror sync \
+gai_strerror sync qsort_r \
getpwent endpwent getgrent endgrent \
cfmakeraw cfsetspeed copysign __executable_start log2)
LIBS=$OLD_LIBS
=== modified file 'src/ChangeLog'
--- a/src/ChangeLog 2014-08-28 18:33:18 +0000
+++ b/src/ChangeLog 2014-08-29 07:29:47 +0000
@@ -1,3 +1,14 @@
+2014-08-29 Dmitry Antipov <address@hidden>
+
+ Add vectors support to Fsort.
+ * fns.c (sort_vector, sort_vector_compare): New functions.
+ (sort_list): Likewise, refactored out of ...
+ (Fsort): ... adjusted user. Mention vectors in docstring.
+ (sort_vector_predicate) [!HAVE_QSORT_R]: New variable.
+ * alloc.c (make_save_int_obj): New function.
+ * lisp.h (enum Lisp_Save_Type): New member SAVE_TYPE_INT_OBJ.
+ (make_save_int_obj): Add prototype.
+
2014-08-28 Ken Brown <address@hidden>
Add support for HYBRID_MALLOC, allowing the use of gmalloc before
=== modified file 'src/alloc.c'
--- a/src/alloc.c 2014-08-28 14:48:02 +0000
+++ b/src/alloc.c 2014-08-29 07:29:47 +0000
@@ -3610,6 +3610,17 @@
return val;
}
+Lisp_Object
+make_save_int_obj (ptrdiff_t a, Lisp_Object b)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_INT_OBJ;
+ p->data[0].integer = a;
+ p->data[1].object = b;
+ return val;
+}
+
#if ! (defined USE_X_TOOLKIT || defined USE_GTK)
Lisp_Object
make_save_ptr_ptr (void *a, void *b)
=== modified file 'src/fns.c'
--- a/src/fns.c 2014-08-25 15:55:46 +0000
+++ b/src/fns.c 2014-08-29 07:29:47 +0000
@@ -1846,13 +1846,12 @@
wrong_type_argument (Qsequencep, seq);
return new;
}
-
-DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
- doc: /* Sort LIST, stably, comparing elements using PREDICATE.
-Returns the sorted list. LIST is modified by side effects.
-PREDICATE is called with two elements of LIST, and should return non-nil
-if the first element should sort before the second. */)
- (Lisp_Object list, Lisp_Object predicate)
+
+/* Sort LIST using PREDICATE, preserving original order of elements
+ considered as equal. */
+
+static Lisp_Object
+sort_list (Lisp_Object list, Lisp_Object predicate)
{
Lisp_Object front, back;
register Lisp_Object len, tem;
@@ -1877,6 +1876,92 @@
return merge (front, back, predicate);
}
+/* Using GNU qsort_r, we can pass this as a parameter. */
+#ifndef HAVE_QSORT_R
+static Lisp_Object sort_vector_predicate;
+#endif
+
+/* Comparison function called by qsort. */
+
+static int
+#ifdef HAVE_QSORT_R
+sort_vector_compare (const void *p, const void *q, void *arg)
+#else
+sort_vector_compare (const void *p, const void *q)
+#endif /* HAVE_QSORT_R */
+{
+ bool more, less;
+ Lisp_Object op, oq, vp, vq;
+#ifdef HAVE_QSORT_R
+ Lisp_Object sort_vector_predicate = *(Lisp_Object *) arg;
+#endif
+
+ op = *(Lisp_Object *) p;
+ oq = *(Lisp_Object *) q;
+ vp = XSAVE_OBJECT (op, 1);
+ vq = XSAVE_OBJECT (oq, 1);
+
+ /* Use recorded element index as a secondary key to
+ preserve original order. Pretty ugly but works. */
+ more = NILP (call2 (sort_vector_predicate, vp, vq));
+ less = NILP (call2 (sort_vector_predicate, vq, vp));
+ return ((more && !less) ? 1
+ : ((!more && less) ? -1
+ : XSAVE_INTEGER (op, 0) - XSAVE_INTEGER (oq, 0)));
+}
+
+/* Sort VECTOR using PREDICATE, preserving original order of elements
+ considered as equal. */
+
+static Lisp_Object
+sort_vector (Lisp_Object vector, Lisp_Object predicate)
+{
+ ptrdiff_t i;
+ EMACS_INT len = ASIZE (vector);
+ Lisp_Object *v = XVECTOR (vector)->contents;
+
+ if (len < 2)
+ return vector;
+ /* Record original index of each element to make qsort stable. */
+ for (i = 0; i < len; i++)
+ v[i] = make_save_int_obj (i, v[i]);
+
+ /* Setup predicate and sort. */
+#ifdef HAVE_QSORT_R
+ qsort_r (v, len, word_size, sort_vector_compare, (void *) &predicate);
+#else
+ sort_vector_predicate = predicate;
+ qsort (v, len, word_size, sort_vector_compare);
+#endif /* HAVE_QSORT_R */
+
+ /* Discard indexes and restore original elements. */
+ for (i = 0; i < len; i++)
+ {
+ Lisp_Object save = v[i];
+ /* Use explicit free to offload GC. */
+ v[i] = XSAVE_OBJECT (save, 1);
+ free_misc (save);
+ }
+ return vector;
+}
+
+DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
+ doc: /* Sort SEQ, stably, comparing elements using PREDICATE.
+Returns the sorted sequence. SEQ should be a list or vector.
+If SEQ is a list, it is modified by side effects. PREDICATE
+is called with two elements of SEQ, and should return non-nil
+if the first element should sort before the second. */)
+ (Lisp_Object seq, Lisp_Object predicate)
+{
+ if (CONSP (seq))
+ seq = sort_list (seq, predicate);
+ else if (VECTORP (seq))
+ seq = sort_vector (seq, predicate);
+ else if (!NILP (seq))
+ wrong_type_argument (Qarrayp, seq);
+ return seq;
+}
+
Lisp_Object
merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
{
=== modified file 'src/lisp.h'
--- a/src/lisp.h 2014-08-28 14:48:02 +0000
+++ b/src/lisp.h 2014-08-29 07:29:47 +0000
@@ -1989,6 +1989,7 @@
SAVE_TYPE_OBJ_OBJ_OBJ_OBJ
= SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS),
SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS),
+ SAVE_TYPE_INT_OBJ = SAVE_INTEGER + (SAVE_OBJECT << SAVE_SLOT_BITS),
SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS),
SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS),
SAVE_TYPE_FUNCPTR_PTR_OBJ
@@ -3773,6 +3774,7 @@
extern Lisp_Object make_save_ptr (void *);
extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
extern Lisp_Object make_save_ptr_ptr (void *, void *);
+extern Lisp_Object make_save_int_obj (ptrdiff_t, Lisp_Object);
extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
Lisp_Object);
extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
=== modified file 'test/ChangeLog'
--- a/test/ChangeLog 2014-08-28 01:59:29 +0000
+++ b/test/ChangeLog 2014-08-29 07:29:47 +0000
@@ -1,3 +1,7 @@
+2014-08-29 Dmitry Antipov <address@hidden>
+
+ * automated/fns-tests.el (fns-tests-sort): New test.
+
2014-08-28 Glenn Morris <address@hidden>
* automated/python-tests.el (python-shell-calculate-exec-path-2):
=== modified file 'test/automated/fns-tests.el'
--- a/test/automated/fns-tests.el 2014-08-02 20:22:31 +0000
+++ b/test/automated/fns-tests.el 2014-08-29 07:29:47 +0000
@@ -100,3 +100,21 @@
(should (compare-strings "こんにちはコンニチハ" nil nil "こんにちはコンニチハ" nil nil))
(should (= (compare-strings "んにちはコンニチハこ" nil nil "こんにちはコンニチハ" nil nil) 1))
(should (= (compare-strings "こんにちはコンニチハ" nil nil "んにちはコンニチハこ" nil nil) -1)))
+
+(ert-deftest fns-tests-sort ()
+ (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
+ '(-1 2 3 4 5 5 7 8 9)))
+ (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
+ '(9 8 7 5 5 4 3 2 -1)))
+ (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
+ [-1 2 3 4 5 5 7 8 9]))
+ (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
+ [9 8 7 5 5 4 3 2 -1]))
+ (should (equal
+ (sort
+ (vector
+ (cons 8 "xxx") (cons 9 "aaa") (cons 8 "bbb") (cons 9 "zzz")
+ (cons 9 "ppp") (cons 8 "ttt") (cons 8 "eee") (cons 9 "fff"))
+ (lambda (x y) (< (car x) (car y))))
+ [(8 . "xxx") (8 . "bbb") (8 . "ttt") (8 . "eee")
+ (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")])))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r117765: Add vectors support to Fsort.,
Dmitry Antipov <=