X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=b73ac29033f7c44aa273907cbd28a163c7728f1e;hb=4ba392170e98744f0ef0b8e08a5d42b988f1d0c9;hp=577d3c39dcaca8f5bca96ee39167b6fc01902a69;hpb=b08c57465f30c0d1632a5ad47a247453698c3bcc;p=sbcl.git

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 577d3c3..b73ac29 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -715,13 +715,13 @@
 ;;; our equality tests, because MEMBER and friends refer to EQLity.
 ;;; So:
 (defun equal-but-no-car-recursion (x y)
-  (cond
-    ((eql x y) t)
-    ((consp x)
-     (and (consp y)
-          (eql (car x) (car y))
-          (equal-but-no-car-recursion (cdr x) (cdr y))))
-    (t nil)))
+  (do () (())
+    (cond ((eql x y) (return t))
+          ((and (consp x)
+                (consp y)
+                (eql (pop x) (pop y))))
+          (t
+           (return)))))
 
 ;;;; package idioms
 
@@ -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))))