From 83ff95b8a70b1dc7cfffdf0a6bb7f4500ebe1ca1 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Wed, 13 Nov 2013 13:14:46 -0500 Subject: [PATCH] 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. --- package-data-list.lisp-expr | 1 + src/code/early-extensions.lisp | 13 +++++++++++++ 2 files changed, 14 insertions(+) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index ca67d02..5730ea0 100644 --- 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 --- 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)))) -- 1.7.10.4