Re: master 4b79c80c999 1/2: New function 'sort-on'

[Michael Heerdegen via "Emacs development discussions." <emacs-devel@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 205 bytes --]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> I gave it a try.  The paragraph in the manual describing `on-sort'
> internals would have to be updated in addition.

Version with one thinko less:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Optimize-sort-on.patch --]
[-- Type: text/x-diff, Size: 2142 bytes --]

From cf41d9abacc6d918cf45ded985fb3dcebd8cc5af Mon Sep 17 00:00:00 2001
From: Michael Heerdegen <michael_heerdegen@web.de>
Date: Tue, 5 Mar 2024 08:03:26 +0100
Subject: [PATCH] Optimize sort-on

* lisp/sort.el (sort-on): Manipulate the argument list instead of
creating new lists with `mapcar'.
---
 lisp/sort.el | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/lisp/sort.el b/lisp/sort.el
index 1e82a097047..5054d98913d 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -30,6 +30,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'cl-lib))
 
 (defgroup sort nil
   "Commands to sort text in an Emacs buffer."
@@ -497,15 +498,25 @@ sort-on
 PREDICATE is the function for comparing keys; it is called with two
 arguments, the keys to compare, and should return non-nil if the
 first key should sort before the second key.
-The return value is always a new list.
+SEQUENCE is modified by side effects.
 This function has the performance advantage of evaluating
 ACCESSOR only once for each element in the input SEQUENCE, and is
 therefore appropriate when computing the key by ACCESSOR is an
 expensive operation.  This is known as the \"decorate-sort-undecorate\"
 paradigm, or the Schwartzian transform."
-  (mapcar #'car
-          (sort (mapcar #'(lambda (x) (cons x (funcall accessor x))) sequence)
-                #'(lambda (x y) (funcall predicate (cdr x) (cdr y))))))
+  (cl-macrolet ((transform (list transformer)
+                  (macroexp-let2 macroexp-copyable-p l list
+                    (macroexp-let2 nil ret l
+                      `(progn
+                         (while ,l
+                           (setcar ,l ,(macroexp-let2 nil elt `(car ,l)
+                                         (funcall transformer elt)))
+                           (setq ,l (cdr ,l)))
+                         ,ret)))))
+    (transform
+     (sort (transform sequence (lambda (x) `(cons ,x (funcall accessor ,x))))
+           #'(lambda (x y) (funcall predicate (cdr x) (cdr y))))
+     (lambda (x) `(car ,x)))))
 
 \f
 (defvar sort-columns-subprocess t)
-- 
2.39.2


[-- Attachment #3: Type: text/plain, Size: 10 bytes --]


Michael.