-;;; SORT-LIST uses a bottom up merge sort. First a pass is made over
-;;; the list grabbing one element at a time and merging it with the
-;;; next one form pairs of sorted elements. Then n is doubled, and
-;;; elements are taken in runs of two, merging one run with the next
-;;; to form quadruples of sorted elements. This continues until n is
-;;; large enough that the inner loop only runs for one iteration; that
-;;; is, there are only two runs that can be merged, the first run
+;;; Destructively merge LIST-1 with LIST-2 (given that they're already
+;;; sorted w.r.t. PRED-FUN on KEY-FUN, giving output sorted the same
+;;; way). In the resulting list, elements of LIST-1 are guaranteed to
+;;; come before equal elements of LIST-2.
+;;;
+;;; Return (VALUES HEAD TAILTAIL), where HEAD is the same value you'd
+;;; expect from MERGE, and TAILTAIL is the last cons in the list (i.e.
+;;; the last cons in the list which NRECONC calls TAIL).
+(defun merge-lists* (list-1 list-2 pred-fun key-fun)
+ (declare (type list list-1 list-2))
+ (declare (type function pred-fun key-fun))
+ (cond ((null list-1) (values list-2 (last-cons-of list-2)))
+ ((null list-2) (values list-1 (last-cons-of list-1)))
+ (t (let* ((reversed-result-so-far nil)
+ (key-1 (funcall key-fun (car list-1)))
+ (key-2 (funcall key-fun (car list-2))))
+ (loop
+ (macrolet ((frob (list-i key-i other-list)
+ `(progn
+ ;; basically
+ ;; (PUSH (POP ,LIST-I) REVERSED-RESULT-SO-FAR),
+ ;; except doing some fancy footwork to
+ ;; reuse the cons cell:
+ (psetf (cdr ,list-i) reversed-result-so-far
+ reversed-result-so-far ,list-i
+ ,list-i (cdr ,list-i))
+ ;; Now maybe we're done.
+ (if (endp ,list-i)
+ (return (values (nreconc
+ reversed-result-so-far
+ ,other-list)
+ (last-cons-of
+ ,other-list)))
+ (setf ,key-i
+ (funcall key-fun (car ,list-i)))))))
+ ;; Note that by making KEY-2 the first arg to
+ ;; PRED-FUN, we arrange that if PRED-FUN is a function
+ ;; in the #'< style, the outcome is stably sorted.
+ (if (funcall pred-fun key-2 key-1)
+ (frob list-2 key-2 list-1)
+ (frob list-1 key-1 list-2))))))))
+
+;;; STABLE-SORT-LIST uses a bottom-up merge sort. First a pass is made
+;;; over the list grabbing one element at a time and merging it with
+;;; the next one to form pairs of sorted elements. Then N is doubled,
+;;; and elements are taken in runs of two, merging one run with the
+;;; next to form quadruples of sorted elements. This continues until N
+;;; is large enough that the inner loop only runs for one iteration;
+;;; that is, there are only two runs that can be merged, the first run