New function SB-IMPL:SCHWARTZIAN-STABLE-SORT-LIST

Stable sort because we really ought to avoid normal sort if we want
reproducible builds, and a Schwartzian transform because we sometimes
sort with fairly computation-heavy sort keys.  Better have that to
make it easy to DTRT.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index ca67d02..5730ea0 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1701,6 +1701,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "SCALE-DOUBLE-FLOAT"
                #!+long-float "SCALE-LONG-FLOAT"
                "SCALE-SINGLE-FLOAT"
+               "SCHWARTZIAN-STABLE-SORT-LIST"
                "SCRUB-POWER-CACHE"
                "SEQUENCEP" "SEQUENCE-COUNT" "SEQUENCE-END"
                "SEQUENCE-OF-CHECKED-LENGTH-GIVEN-TYPE"

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index dd7742e..b73ac29 100644 (file)
--- 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))))