From: Paul Khuong Date: Wed, 13 Nov 2013 18:14:46 +0000 (-0500) Subject: New function SB-IMPL:SCHWARTZIAN-STABLE-SORT-LIST X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=83ff95b8a70b1dc7cfffdf0a6bb7f4500ebe1ca1;p=sbcl.git 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 --- 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))))