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

[Michael Heerdegen <michael_heerdegen@web.de>]

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

Dmitry Gutov <dmitry@gutov.dev> writes:

> Good. So if there are no strong objections from anyone, I'd like to
> see this happen.

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


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

From 826cbb2b492541eac3210c094dabefe0a8c28cf1 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 | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/lisp/sort.el b/lisp/sort.el
index 1e82a097047..9a110a754ca 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,26 @@ 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 macroexp-copyable-p
+                                           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: 11 bytes --]



Michael.