+;;; Small specialised stable sorts
+(declaim (inline stable-sort-list-2 stable-sort-list-3))
+(defun stable-sort-list-2 (list test key)
+ (declare (type cons list)
+ (type function test key))
+ (let ((second (cdr list)))
+ (declare (type cons second))
+ (when (funcall test (funcall key (car second))
+ (funcall key (car list)))
+ (rotatef (car list) (car second)))
+ (values list second (shiftf (cdr second) nil))))
+
+(defun stable-sort-list-3 (list test key)
+ (declare (type cons list)
+ (type function test key))
+ (let* ((second (cdr list))
+ (third (cdr second))
+ (x (car list))
+ (y (car second))
+ (z (car third)))
+ (declare (type cons second third))
+ (when (funcall test (funcall key y)
+ (funcall key x))
+ (rotatef x y))
+ (let ((key-z (funcall key z)))
+ (when (funcall test key-z
+ (funcall key y))
+ (if (funcall test key-z
+ (funcall key x))
+ (rotatef x z y)
+ (rotatef z y))))
+ (setf (car list) x
+ (car second) y
+ (car third) z)
+ (values list third (shiftf (cdr third) nil))))
+