From 67712e5624fd0792f1d2dedef940daabb79dcc15 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Thu, 30 Mar 2017 01:17:30 +0900
Subject: [PATCH] adding (srfi 132)

---
 lib/srfi/132.sld      |  19 ++
 lib/srfi/132/sort.scm | 172 +++++++++++
 lib/srfi/132/test.sld | 686 ++++++++++++++++++++++++++++++++++++++++++
 lib/srfi/95/qsort.c   |   5 +-
 4 files changed, 881 insertions(+), 1 deletion(-)
 create mode 100644 lib/srfi/132.sld
 create mode 100644 lib/srfi/132/sort.scm
 create mode 100644 lib/srfi/132/test.sld

diff --git a/lib/srfi/132.sld b/lib/srfi/132.sld
new file mode 100644
index 00000000..6d2a1420
--- /dev/null
+++ b/lib/srfi/132.sld
@@ -0,0 +1,19 @@
+(define-library (srfi 132)
+  (import (scheme base) (srfi 95))
+  (export
+   list-sorted? vector-sorted?
+   list-sort list-stable-sort
+   list-sort! list-stable-sort!
+   vector-sort vector-stable-sort
+   vector-sort! vector-stable-sort!
+   list-merge list-merge!
+   vector-merge vector-merge!
+   list-delete-neighbor-dups
+   list-delete-neighbor-dups!
+   vector-delete-neighbor-dups
+   vector-delete-neighbor-dups!
+   vector-find-median
+   vector-find-median!
+   vector-select!
+   vector-separate!)
+  (include "132/sort.scm"))
diff --git a/lib/srfi/132/sort.scm b/lib/srfi/132/sort.scm
new file mode 100644
index 00000000..b840ee9b
--- /dev/null
+++ b/lib/srfi/132/sort.scm
@@ -0,0 +1,172 @@
+
+(define (list-sorted? < ls) (sorted? ls <))
+(define (vector-sorted? < vec) (sorted? vec <))
+
+(define (list-sort < ls) (sort ls <))
+(define (list-stable-sort < ls) (sort ls <))
+
+(define (vector-sort < vec . o)
+  (if (pair? o) (sort (apply vector-copy vec o) <) (sort vec <)))
+(define vector-stable-sort vector-sort)
+
+(define (list-sort! < ls) (sort! ls <))
+(define (list-stable-sort! < ls) (sort! ls <))
+
+(define (vector-sort! < vec . o)
+  (if (pair? o)
+      (let ((v (vector-sort! < (apply vector-copy vec o))))
+        (vector-copy! vec (car o) v)
+        vec)
+      (sort! vec <)))
+(define vector-stable-sort! vector-sort!)
+
+(define (list-merge < ls1 ls2) (merge ls1 ls2 <))
+(define (list-merge! < ls1 ls2) (merge! ls1 ls2 <))
+
+(define (vector-merge less vec1 vec2 . o)
+  (if (pair? o)
+      (if (pair? (cdr o))
+          (vector-merge less
+                        (vector-copy vec1 (car o) (cadr o))
+                        (apply vector-copy vec2 (cddr o)))
+          (vector-merge less (vector-copy vec1 (car o)) vec2))
+      (let* ((e1 (vector-length vec1))
+             (e2 (vector-length vec2))
+             (res (make-vector (+ e1 e2))))
+        (let lp ((i 0) (i1 0) (i2 0))
+          (cond
+           ((and (>= i1 e1) (>= i2 e2)) res)
+           ((or (>= i1 e1)
+                (and (< i2 e2)
+                     (less (vector-ref vec2 i2) (vector-ref vec1 i1))))
+            (vector-set! res i (vector-ref vec2 i2))
+            (lp (+ i 1) i1 (+ i2 1)))
+           (else
+            (vector-set! res i (vector-ref vec1 i1))
+            (lp (+ i 1) (+ i1 1) i2)))))))
+
+(define (vector-merge! < to vec1 vec2 . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (o (if (pair? o) (cdr o) '())))
+    (let ((res (apply vector-merge < vec1 vec2 o)))
+      (vector-copy! to start res))))
+
+(define (list-delete-neighbor-dups eq ls)
+  (let lp ((ls ls) (res '()))
+    (cond ((null? ls) (reverse res))
+          ((and (pair? res) (eq (car res) (car ls))) (lp (cdr ls) res))
+          (else (lp (cdr ls) (cons (car ls) res))))))
+
+(define (list-delete-neighbor-dups! eq ls)
+  (if (pair? ls)
+      (let lp ((ls (cdr ls)) (start ls))
+        (cond ((null? ls) (set-cdr! start '()))
+              ((eq (car start) (car ls)) (lp (cdr ls) start))
+              (else (set-cdr! start ls) (lp (cdr ls) ls)))))
+  ls)
+
+(define (vector-delete-neighbor-dups eq vec . o)
+  (if (zero? (vector-length vec))
+      vec
+      (let ((ls (if (and (pair? o) (pair? (cdr o)))
+                    (vector->list vec (car o) (cadr o))
+                    (apply vector->list vec o))))
+        (list->vector (list-delete-neighbor-dups eq ls)))))
+
+(define (vector-delete-neighbor-dups! eq vec . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (vector-length vec))))
+    (cond
+     ((<= end start) start)
+     (else
+      (let lp ((i (+ start 1))
+               (fill (+ start 1)))
+        (cond
+         ((>= i end) fill)
+         ((eq (vector-ref vec (- i 1)) (vector-ref vec i)) (lp (+ i 1) fill))
+         (else
+          (if (> i fill)
+              (vector-set! vec fill (vector-ref vec i)))
+          (lp (+ i 1) (+ fill 1)))))))))
+
+;; Median of 3 (good in practice, use median-of-medians for guaranteed
+;; linear time).
+(define (choose-pivot < vec left right)
+  (let* ((mid (quotient (+ left right) 2))
+         (a (vector-ref vec left))
+         (b (vector-ref vec mid))
+         (c (vector-ref vec right)))
+    (if (< a b)
+        (if (< b c) mid (if (< a c) right left))
+        (if (< a c) left (if (< b c) right mid)))))
+
+;; Partitions around elt and returns the resulting median index.
+(define (vector-partition! < vec left right pivot)
+  (define (swap! i j)
+    (let ((tmp (vector-ref vec i)))
+      (vector-set! vec i (vector-ref vec j))
+      (vector-set! vec j tmp)))
+  (let ((elt (vector-ref vec pivot)))
+    (swap! pivot right)
+    (let lp ((i left)
+             (j left))
+      (cond
+       ((= i right)
+        (swap! i j)
+        j)
+       ((< (vector-ref vec i) elt)
+        (swap! i j)
+        (lp (+ i 1) (+ j 1)))
+       (else
+        (lp (+ i 1) j))))))
+
+;; Permutes vec in-place to move the k smallest elements as ordered by
+;; < to the beginning of the vector (unsorted).  Returns the nth smallest.
+(define (vector-select! < vec k . o)
+  (let* ((left (if (pair? o) (car o) 0))
+         (k (+ k left)))
+    (if (not (<= 0 k (vector-length vec)))
+        (error "k out of range" vec k))
+    (let select ((left left)
+                 (right (- (if (and (pair? o) (pair? (cdr o)))
+                               (cadr o)
+                               (vector-length vec))
+                           1)))
+      (if (>= left right)
+          (vector-ref vec left)
+          (let* ((pivot (choose-pivot < vec left right))
+                 (pivot-index (vector-partition! < vec left right pivot)))
+            (cond
+             ((= k pivot-index)
+              (vector-ref vec k))
+             ((< k pivot-index)
+              (select left (- pivot-index 1)))
+             (else
+              (select (+ pivot-index 1) right))))))))
+
+(define (vector-separate! < vec k . o)
+  (apply vector-select! < vec k o)
+  (if #f #f))
+
+(define (vector-find-median! < vec knil . o)
+  (vector-sort! < vec)  ; required by SRFI 132
+  (let* ((len (vector-length vec))
+         (mid (quotient len 2))
+         (mean (if (pair? o) (car o) (lambda (a b) (/ (+ a b) 2)))))
+    (cond
+     ((zero? len) knil)
+     ((odd? len) (vector-ref vec mid))
+     (else (mean (vector-ref vec (- mid 1)) (vector-ref vec mid))))))
+
+(define (vector-find-median < vec knil . o)
+  (let* ((vec (vector-copy vec))
+         (len (vector-length vec))
+         (mid (quotient len 2))
+         (mean (if (pair? o) (car o) (lambda (a b) (/ (+ a b) 2)))))
+    (cond
+     ((zero? len) knil)
+     (else
+      (vector-separate! < vec mid)
+      (cond
+       ((odd? len) (vector-ref vec mid))
+       (else (mean (vector-ref vec (- mid 1)) (vector-ref vec mid))))))))
diff --git a/lib/srfi/132/test.sld b/lib/srfi/132/test.sld
new file mode 100644
index 00000000..4bf7d0bc
--- /dev/null
+++ b/lib/srfi/132/test.sld
@@ -0,0 +1,686 @@
+(define-library (srfi 132 test)
+  (import (scheme base) (srfi 132) (chibi test))
+  (export run-tests)
+  (begin
+    (define (run-tests)
+      (test-begin "sorting")
+      (test '()
+          (list-sort > (list)))
+      (test '(987)
+          (list-sort > (list 987)))
+      (test '(987 654)
+          (list-sort > (list 987 654)))
+      (test '(9 8 7 6 5 4 3 2 1 0)
+          (list-sort > (list 9 8 6 3 0 4 2 5 7 1)))
+      (test '()
+          (list-stable-sort > (list)))
+      (test '(987)
+          (list-stable-sort > (list 987)))
+      (test '(987 654)
+          (list-stable-sort > (list 987 654)))
+      (test '(9 8 7 6 5 4 3 2 1 0)
+          (list-stable-sort > (list 9 8 6 3 0 4 2 5 7 1)))
+      (test '(9 8 6 7 4 5 3 2 0 1)
+          (list-stable-sort (lambda (x y)
+                              (> (quotient x 2)
+                                 (quotient y 2)))
+                            (list 9 8 6 3 0 4 2 5 7 1)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-sort > v)))
+      (test '#(987)
+          (let ((v (vector 987)))
+            (vector-sort > (vector 987))))
+      (test '#(987 654)
+          (let ((v (vector 987 654)))
+            (vector-sort > v)))
+      (test '#(9 8 7 6 5 4 3 2 1 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-sort > v)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-stable-sort > v)))
+      (test '#(987)
+          (let ((v (vector 987)))
+            (vector-stable-sort > (vector 987))))
+      (test '#(987 654)
+          (let ((v (vector 987 654)))
+            (vector-stable-sort > v)))
+      (test '#(9 8 7 6 5 4 3 2 1 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort > v)))
+      (test '#(9 8 6 7 4 5 3 2 0 1)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort (lambda (x y)
+                                  (> (quotient x 2)
+                                     (quotient y 2)))
+                                v)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-sort > v 0)))
+      (test '#()
+          (let ((v (vector 987)))
+            (vector-sort > (vector 987) 1)))
+      (test '#(654)
+          (let ((v (vector 987 654)))
+            (vector-sort > v 1)))
+      (test '#(7 5 4 3 2 1 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-sort > v 3)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-stable-sort > v 0)))
+      (test '#()
+          (let ((v (vector 987)))
+            (vector-stable-sort > (vector 987) 1)))
+      (test '#(654 987)
+          (let ((v (vector 987 654)))
+            (vector-stable-sort < v 0 2)))
+      (test '#(7 5 4 3 2 1 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort > v 3)))
+      (test '#(7 4 5 3 2 0 1)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort (lambda (x y)
+                                  (> (quotient x 2)
+                                     (quotient y 2)))
+                                v
+                                3)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-sort > v 0 0)))
+      (test '#()
+          (let ((v (vector 987)))
+            (vector-sort > (vector 987) 1 1)))
+      (test '#(654)
+          (let ((v (vector 987 654)))
+            (vector-sort > v 1 2)))
+      (test '#(5 4 2 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-sort > v 4 8)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-stable-sort > v 0 0)))
+      (test '#()
+          (let ((v (vector 987)))
+            (vector-stable-sort > (vector 987) 1 1)))
+      (test '#(654)
+          (let ((v (vector 987 654)))
+            (vector-stable-sort > v 1 2)))
+      (test '#(6 4 3 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort > v 2 6)))
+      (test '#(8 6 4 5 3 2 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort (lambda (x y)
+                                  (> (quotient x 2)
+                                     (quotient y 2)))
+                                v
+                                1
+                                8)))
+      (test '()
+          (list-sort! > (list)))
+      (test '(987)
+          (list-sort! > (list 987)))
+      (test '(987 654)
+          (list-sort! > (list 987 654)))
+      (test '(9 8 7 6 5 4 3 2 1 0)
+          (list-sort! > (list 9 8 6 3 0 4 2 5 7 1)))
+      (test '()
+          (list-stable-sort! > (list)))
+      (test '(987)
+          (list-stable-sort! > (list 987)))
+      (test '(987 654)
+          (list-stable-sort! > (list 987 654)))
+      (test '(9 8 7 6 5 4 3 2 1 0)
+          (list-stable-sort! > (list 9 8 6 3 0 4 2 5 7 1)))
+      (test '(9 8 6 7 4 5 3 2 0 1)
+          (list-stable-sort! (lambda (x y)
+                               (> (quotient x 2)
+                                  (quotient y 2)))
+                             (list 9 8 6 3 0 4 2 5 7 1)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-sort! > v)
+            v))
+      (test '#(987)
+          (let ((v (vector 987)))
+            (vector-sort! > (vector 987))
+            v))
+      (test '#(987 654)
+          (let ((v (vector 987 654)))
+            (vector-sort! > v)
+            v))
+      (test '#(9 8 7 6 5 4 3 2 1 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-sort! > v)
+            v))
+      (test '#()
+          (let ((v (vector)))
+            (vector-stable-sort! > v)
+            v))
+      (test '#(987)
+          (let ((v (vector 987)))
+            (vector-stable-sort! > (vector 987))
+            v))
+      (test '#(987 654)
+          (let ((v (vector 987 654)))
+            (vector-stable-sort! > v)
+            v))
+      (test '#(9 8 7 6 5 4 3 2 1 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort! > v)
+            v))
+      (test '#(9 8 6 7 4 5 3 2 0 1)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort! (lambda (x y)
+                                   (> (quotient x 2)
+                                      (quotient y 2)))
+                                 v)
+            v))
+      (test '#()
+          (let ((v (vector)))
+            (vector-sort! > v 0)
+            v))
+      (test '#(987)
+          (let ((v (vector 987)))
+            (vector-sort! > (vector 987) 1)
+            v))
+      (test '#(987 654)
+          (let ((v (vector 987 654)))
+            (vector-sort! > v 1)
+            v))
+      (test '#(9 8 6 7 5 4 3 2 1 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-sort! > v 3)
+            v))
+      (test '#()
+          (let ((v (vector)))
+            (vector-stable-sort! > v 0)
+            v))
+      (test '#(987)
+          (let ((v (vector 987)))
+            (vector-stable-sort! > (vector 987) 1)
+            v))
+      (test '#(654 987)
+          (let ((v (vector 987 654)))
+            (vector-stable-sort! < v 0 2)
+            v))
+      (test '#(9 8 6 7 5 4 3 2 1 0)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort! > v 3)
+            v))
+      (test '#(9 8 6 7 4 5 3 2 0 1)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort! (lambda (x y)
+                                   (> (quotient x 2)
+                                      (quotient y 2)))
+                                 v
+                                 3)
+            v))
+      (test '#()
+          (let ((v (vector)))
+            (vector-sort! > v 0 0)
+            v))
+      (test '#(987)
+          (let ((v (vector 987)))
+            (vector-sort! > (vector 987) 1 1)
+            v))
+      (test '#(987 654)
+          (let ((v (vector 987 654)))
+            (vector-sort! > v 1 2)
+            v))
+      (test '#(9 8 6 3 5 4 2 0 7 1)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-sort! > v 4 8)
+            v))
+      (test '#()
+          (let ((v (vector)))
+            (vector-stable-sort! > v 0 0)
+            v))
+      (test '#(987)
+          (let ((v (vector 987)))
+            (vector-stable-sort! > (vector 987) 1 1)
+            v))
+      (test '#(987 654)
+          (let ((v (vector 987 654)))
+            (vector-stable-sort! > v 1 2)
+            v))
+      (test '#(9 8 6 4 3 0 2 5 7 1)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort! > v 2 6)
+            v))
+      (test '#(9 8 6 4 5 3 2 0 7 1)
+          (let ((v (vector 9 8 6 3 0 4 2 5 7 1)))
+            (vector-stable-sort! (lambda (x y)
+                                   (> (quotient x 2)
+                                      (quotient y 2)))
+                                 v
+                                 1
+                                 8)
+            v))
+      (test (list-merge > (list) (list))
+          '())
+      (test '(9 6 3 0)
+          (list-merge > (list) (list 9 6 3 0)))
+      (test '(9 7 5 3 1)
+          (list-merge > (list 9 7 5 3 1) (list)))
+      (test '(9 9 7 6 5 3 3 1 0)
+          (list-merge > (list 9 7 5 3 1) (list 9 6 3 0)))
+      (test '()
+          (list-merge! > (list) (list)))
+      (test '(9 6 3 0)
+          (list-merge! > (list) (list 9 6 3 0)))
+      (test '(9 7 5 3 1)
+          (list-merge! > (list 9 7 5 3 1) (list)))
+      (test '(9 9 7 6 5 3 3 1 0)
+          (list-merge! > (list 9 7 5 3 1) (list 9 6 3 0)))
+      (test '#()
+          (vector-merge > (vector) (vector)))
+      (test '#(9 6 3 0)
+          (vector-merge > (vector) (vector 9 6 3 0)))
+      (test '#(9 7 5 3 1)
+          (vector-merge > (vector 9 7 5 3 1) (vector)))
+      (test '#(9 9 7 6 5 3 3 1 0)
+          (vector-merge > (vector 9 7 5 3 1) (vector 9 6 3 0)))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector))
+            v))
+      (test '#( 9  6  3  0 #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0))
+            v))
+      (test '#( 9  7  5  3  1 #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector))
+            v))
+      (test '#( 9  9  7  6  5  3  3  1  0 #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0))
+            v))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 0)
+            v))
+      (test '#( 9  6  3  0 #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 0)
+            v))
+      (test '#( 9  7  5  3  1 #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 0)
+            v))
+      (test '#( 9  9  7  6  5  3  3  1  0 #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 0)
+            v))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 2)
+            v))
+      (test '#(#f #f 9  6  3  0 #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 2)
+            v))
+      (test '#(#f #f  9  7  5  3  1 #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 2)
+            v))
+      (test '#(#f #f 9  9  7  6  5  3  3  1  0 #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 2)
+            v))
+      (test '#()
+          (vector-merge > (vector) (vector) 0))
+      (test '#(9 6 3 0)
+          (vector-merge > (vector) (vector 9 6 3 0) 0))
+      (test '#(5 3 1)
+          (vector-merge > (vector 9 7 5 3 1) (vector) 2))
+      (test '#(9 6 5 3 3 1 0)
+          (vector-merge > (vector 9 7 5 3 1) (vector 9 6 3 0) 2))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 2 0)
+            v))
+      (test '#(#f #f 9  6  3  0 #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 2 0)
+            v))
+      (test '#(#f #f 5  3  1 #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 2 2)
+            v))
+      (test '#(#f #f  9   6  5  3  3  1  0 #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 2 2)
+            v))
+      (test '#()
+          (vector-merge > (vector) (vector) 0 0))
+      (test '#(9 6 3 0)
+          (vector-merge > (vector) (vector 9 6 3 0) 0 0))
+      (test '#(5 3 1)
+          (vector-merge > (vector 9 7 5 3 1) (vector) 2 5))
+      (test '#(9 6 5 3 3 1 0)
+          (vector-merge > (vector 9 7 5 3 1) (vector 9 6 3 0) 2 5))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 2 0 0)
+            v))
+      (test '#(#f #f 9  6  3  0 #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 2 0 0)
+            v))
+      (test '#(#f #f 5  3  1 #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 2 2 5)
+            v))
+      (test '#(#f #f  9  6  5  3  3  1  0 #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 2 2 5)
+            v))
+      (test '#()
+          (vector-merge > (vector) (vector) 0 0))
+      (test '#(9 6 3 0)
+          (vector-merge > (vector) (vector 9 6 3 0) 0 0))
+      (test '#(5 3)
+          (vector-merge > (vector 9 7 5 3 1) (vector) 2 4))
+      (test '#(9 6 5 3 3 0)
+          (vector-merge > (vector 9 7 5 3 1) (vector 9 6 3 0) 2 4))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 2 0 0)
+            v))
+      (test '#(#f #f 9  6  3  0 #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 2 0 0)
+            v))
+      (test '#(#f #f 5  3 #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 2 2 4)
+            v))
+      (test '#(#f #f  9  6  5  3  3  0 #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 2 2 4)
+            v))
+      (test '#()
+          (vector-merge > (vector) (vector) 0 0 0))
+      (test '#(9 6 3 0)
+          (vector-merge > (vector) (vector 9 6 3 0) 0 0 0))
+      (test '#(5 3)
+          (vector-merge > (vector 9 7 5 3 1) (vector) 2 4 0))
+      (test '#(9 6 5 3 3 0)
+          (vector-merge > (vector 9 7 5 3 1) (vector 9 6 3 0) 2 4 0))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 2 0 0 0)
+            v))
+      (test '#(#f #f  9  6  3  0 #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 2 0 0 0)
+            v))
+      (test '#(#f #f  5  3 #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 2 2 4 0)
+            v))
+      (test '#(#f #f  9  6  5  3  3  0 #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 2 2 4 0)
+            v))
+      (test '#()
+          (vector-merge > (vector) (vector) 0 0 0))
+      (test '#(6 3 0)
+          (vector-merge > (vector) (vector 9 6 3 0) 0 0 1))
+      (test '#(5 3)
+          (vector-merge > (vector 9 7 5 3 1) (vector) 2 4 0))
+      (test '#(6 5 3 3 0)
+          (vector-merge > (vector 9 7 5 3 1) (vector 9 6 3 0) 2 4 1))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 2 0 0 0)
+            v))
+      (test '#(#f #f  6  3  0 #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 2 0 0 1)
+            v))
+      (test '#(#f #f  5  3 #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 2 2 4 0)
+            v))
+      (test '#(#f #f  6  5  3  3  0 #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 2 2 4 1)
+            v))
+      (test '#()
+          (vector-merge > (vector) (vector) 0 0 0 0))
+      (test '#(6 3 0)
+          (vector-merge > (vector) (vector 9 6 3 0) 0 0 1 4))
+      (test '#(5 3)
+          (vector-merge > (vector 9 7 5 3 1) (vector) 2 4 0 0))
+      (test '#(6 5 3 3 0)
+          (vector-merge > (vector 9 7 5 3 1) (vector 9 6 3 0) 2 4 1 4))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 2 0 0 0 0)
+            v))
+      (test '#(#f #f  6  3  0 #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 2 0 0 1 4)
+            v))
+      (test '#(#f #f  5  3 #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 2 2 4 0 0)
+            v))
+      (test '#(#f #f  6  5  3  3  0 #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 2 2 4 1 4)
+            v))
+      (test '#()
+          (vector-merge > (vector) (vector) 0 0 0 0))
+      (test '#(6)
+          (vector-merge > (vector) (vector 9 6 3 0) 0 0 1 2))
+      (test '#(5 3)
+          (vector-merge > (vector 9 7 5 3 1) (vector) 2 4 0 0))
+      (test '#(6 5 3)
+          (vector-merge > (vector 9 7 5 3 1) (vector 9 6 3 0) 2 4 1 2))
+      (test '#(#f #f #f #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector) 2 0 0 0 0)
+            v))
+      (test '#(#f #f  6 #f #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector) (vector 9 6 3 0) 2 0 0 1 2)
+            v))
+      (test '#(#f #f  5  3 #f #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector) 2 2 4 0 0)
+            v))
+      (test '#(#f #f  6  5  3 #f #f #f #f #f #f #f)
+          (let ((v (make-vector 12 #f)))
+            (vector-merge! > v (vector 9 7 5 3 1) (vector 9 6 3 0) 2 2 4 1 2)
+            v))
+      (test '()
+          (list-delete-neighbor-dups char=? (list)))
+      (test '(#\a)
+          (list-delete-neighbor-dups char=? (list #\a)))
+      (test '(#\a #\b #\a)
+          (list-delete-neighbor-dups char=? (list #\a #\a #\a #\b #\b #\a)))
+      (test '()
+          (list-delete-neighbor-dups! char=? (list)))
+      (test '(#\a)
+          (list-delete-neighbor-dups! char=? (list #\a)))
+      (test '(#\a #\b #\a)
+          (list-delete-neighbor-dups! char=? (list #\a #\a #\a #\b #\b #\a)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-delete-neighbor-dups char=? v)))
+      (test '#(#\a)
+          (let ((v (vector #\a)))
+            (vector-delete-neighbor-dups char=? v)))
+      (test '#(#\a #\b #\a)
+          (let ((v (vector #\a #\a #\a #\b #\b #\a)))
+            (vector-delete-neighbor-dups char=? v)))
+      (test '(0 #())
+          (let ((v (vector)))
+            (list (vector-delete-neighbor-dups! char=? v) v)))
+      (test '(1 #(#\a))
+          (let ((v (vector #\a)))
+            (list (vector-delete-neighbor-dups! char=? v) v)))
+      (test '(3 #(#\a #\b #\a #\b #\b #\a))
+          (let ((v (vector #\a #\a #\a #\b #\b #\a)))
+            (list (vector-delete-neighbor-dups! char=? v) v)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-delete-neighbor-dups char=? v 0)))
+      (test '#(#\a)
+          (let ((v (vector #\a)))
+            (vector-delete-neighbor-dups char=? v 0)))
+      (test '#(#\a #\b #\a)
+          (let ((v (vector #\a #\a #\a #\b #\b #\a)))
+            (vector-delete-neighbor-dups char=? v 0)))
+      (test '(0 #())
+          (let ((v (vector)))
+            (list (vector-delete-neighbor-dups! char=? v 0) v)))
+      (test '(1 #(#\a))
+          (let ((v (vector #\a)))
+            (list (vector-delete-neighbor-dups! char=? v 0) v)))
+      (test '(3 #(#\a #\b #\a #\b #\b #\a))
+          (let ((v (vector #\a #\a #\a #\b #\b #\a)))
+            (list (vector-delete-neighbor-dups! char=? v 0) v)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-delete-neighbor-dups char=? v 0)))
+      (test '#()
+          (let ((v (vector #\a)))
+            (vector-delete-neighbor-dups char=? v 1)))
+      (test '#(#\b #\a)
+          (let ((v (vector #\a #\a #\a #\b #\b #\a)))
+            (vector-delete-neighbor-dups char=? v 3)))
+      (test '(0 #())
+          (let ((v (vector)))
+            (list (vector-delete-neighbor-dups! char=? v 0) v)))
+      (test '(1 #(#\a))
+          (let ((v (vector #\a)))
+            (list (vector-delete-neighbor-dups! char=? v 1) v)))
+      (test '(5 #(#\a #\a #\a #\b #\a #\a))
+          (let ((v (vector #\a #\a #\a #\b #\b #\a)))
+            (list (vector-delete-neighbor-dups! char=? v 3) v)))
+      (test '#()
+          (let ((v (vector)))
+            (vector-delete-neighbor-dups char=? v 0 0)))
+      (test '#()
+          (let ((v (vector #\a)))
+            (vector-delete-neighbor-dups char=? v 1 1)))
+      (test '#(#\b)
+          (let ((v (vector #\a #\a #\a #\b #\b #\a)))
+            (vector-delete-neighbor-dups char=? v 3 5)))
+      (test '(0 #())
+          (let ((v (vector)))
+            (list (vector-delete-neighbor-dups! char=? v 0 0) v)))
+      (test '(1 #(#\a))
+          (let ((v (vector #\a)))
+            (list (vector-delete-neighbor-dups! char=? v 0 1) v)))
+      (test '(1 #(#\a))
+          (let ((v (vector #\a)))
+            (list (vector-delete-neighbor-dups! char=? v 1 1) v)))
+      (test '(4 #(#\a #\a #\a #\b #\b #\a))
+          (let ((v (vector #\a #\a #\a #\b #\b #\a)))
+            (list (vector-delete-neighbor-dups! char=? v 3 5) v)))
+      (let ((v (vector 0 0 0 1 1 2 2 3 3 4 4 5 5 6 6)))
+        (test '(9 . #(0 0 0 1 2 3 4 5 6 4 4 5 5 6 6))
+            (cons (vector-delete-neighbor-dups! = v 3) v)))
+      (test "knil" (vector-find-median < (vector) "knil"))
+      (test 17 (vector-find-median < (vector 17) "knil"))
+      (test 12 (vector-find-median < (vector 18 1 12 14 12 5 18 2) "knil"))
+      (test 23/2 (vector-find-median < (vector 18 1 11 14 12 5 18 2) "knil"))
+      (test (list 12 12)
+          (vector-find-median < (vector 18 1 12 14 12 5 18 2) "knil" list))
+      (test (list 11 12)
+          (vector-find-median < (vector 18 1 11 14 12 5 18 2) "knil" list))
+      (test 7 (vector-find-median < (vector 7 6 9 3 1 18 15 7 8) "knil"))
+      (test 7 (vector-find-median < (vector 7 6 9 3 1 18 15 7 8) "knil" list))
+      (test 19
+          (let ((v (vector 19)))
+            (vector-select! < v 0)))
+      (test 3
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 0)))
+      (test 9
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 2)))
+      (test 22
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 8)))
+      (test 23
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 9)))
+      (test 19
+          (let ((v (vector 19)))
+            (vector-select! < v 0 0)))
+      (test 3
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 0 0)))
+      (test 9
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 2 0)))
+      (test 22
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 8 0)))
+      (test 23
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 9 0)))
+      (test 19
+          (let ((v (vector 19)))
+            (vector-select! < v 0 0 1)))
+      (test 3
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 0 0 10)))
+      (test 9
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 2 0 10)))
+      (test 22
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 8 0 10)))
+      (test 23
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 9 0 10)))
+      (test 3
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 0 4 10)))
+      (test 13
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 2 4 10)))
+      (test 21
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 4 4 10)))
+      (test 23
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 5 4 10)))
+      (test 3
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 0 4 10)))
+      (test 13
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 2 4 10)))
+      (test 13
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 3 4 10)))
+      (test 21
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 4 4 10)))
+      (test 23
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 5 4 10)))
+      (test 9
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 0 4 8)))
+      (test 13
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 1 4 8)))
+      (test 13
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 2 4 8)))
+      (test 21
+          (let ((v (vector 8 22 19 19 13 9 21 13 3 23)))
+            (vector-select! < v 3 4 8)))
+      (test-end))))
diff --git a/lib/srfi/95/qsort.c b/lib/srfi/95/qsort.c
index 527a302f..98a8f0cd 100644
--- a/lib/srfi/95/qsort.c
+++ b/lib/srfi/95/qsort.c
@@ -287,7 +287,8 @@ sexp sexp_sort_x (sexp ctx, sexp self, sexp_sint_t n, sexp seq,
   sexp res;
   sexp_gc_var2(vec, scratch);
 
-  if (sexp_nullp(seq)) return seq;
+  if (sexp_nullp(seq) || seq == sexp_global(ctx, SEXP_G_EMPTY_VECTOR))
+    return seq;
 
   sexp_gc_preserve2(ctx, vec, scratch);
 
@@ -312,6 +313,8 @@ sexp sexp_sort_x (sexp ctx, sexp self, sexp_sint_t n, sexp seq,
       res = sexp_merge_sort_less(ctx, sexp_vector_data(vec),
                                  sexp_vector_data(scratch),
                                  0, len-1, less, key);
+      if (!sexp_exceptionp(res))
+        res = scratch;
     }
   }