X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=b73ac29033f7c44aa273907cbd28a163c7728f1e;hb=83ff95b8a70b1dc7cfffdf0a6bb7f4500ebe1ca1;hp=dd7742e8f66a5ccf2f44f16215cb76437201270c;hpb=34cd57c90426635eb8c7f63efd37e036c4b8d891;p=sbcl.git

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index dd7742e..b73ac29 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -1436,3 +1436,16 @@ to :INTERPRET, an interpreter will be used.")
                        (list (list :line lineno)
                              (list :column colno)
                              (list :file-position pos)))))))
+
+(declaim (inline schwartzian-stable-sort-list))
+(defun schwartzian-stable-sort-list (list comparator &key key)
+  (if (null key)
+      (stable-sort (copy-list list) comparator)
+      (let* ((key (if (functionp key)
+                      key
+                      (symbol-function key)))
+             (wrapped (mapcar (lambda (x)
+                                (cons x (funcall key x)))
+                              list))
+             (sorted (stable-sort wrapped comparator :key #'cdr)))
+        (map-into sorted #'car sorted))))