bug#58950: [PATCH] * lisp/subr.el (buffer-match-p): Optimise performance

[Philip Kaludercic <philipk@posteo.net>]

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

Tags: patch


The below patch is based on a tangent discussion in bug#58839, the below
patch was written in collaboration with João Távora.  It involves an
optimisation to `buffer-match-p' that dramatically speeds the execution
of the function.  This is important for the very least as
`buffer-match-p' is used for displaying buffer.

Running (benchmark-run 1000 (match-buffers "\\*.+\\*")) I previously got
(22.822269875 178 15.524474267999977), and with the patch applied
(0.27100275 2 0.1730835160000197).

There are a few points that can be discussed:

1. Style.  I wrap the defun in a let (or rather letrec) block to avoid
   littering the global namespace.  It isn't necessary, and one could
   argue it makes debugging more difficult.

2. Caching policy.  Caching is critical to this optimisation.  Just
   using byte-compilation would cause the above test to slow down to
   (76.323692627 656 57.088315405).  The question is if the hash map
   will collect too much garbage over time, and if there is a better
   approach that could be taken?

In GNU Emacs 29.0.50 (build 3, x86_64-pc-linux-gnu, GTK+ Version
 3.24.30, cairo version 1.16.0) of 2022-10-31 built on heron
Repository revision: 462a66e79edcc34ecbeef7cc1604765adfdc038e
Repository branch: feature/package+vc
System Description: Guix System

Configured using:
 'configure --with-pgtk --with-imagemagick
 PKG_CONFIG_PATH=/gnu/store/ssg343s6ldqdwh30136pnawhbgd0cb6i-profile/lib/pkgconfig:/gnu/store/ssg343s6ldqdwh30136pnawhbgd0cb6i-profile/share/pkgconfig'


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-lisp-subr.el-buffer-match-p-Accelerate-using-byte-co.patch --]
[-- Type: text/patch, Size: 4214 bytes --]

From 0a9ddbcc6958fa7ed94456722a3eee65582a56b2 Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <philipk@posteo.net>
Date: Tue, 1 Nov 2022 19:57:49 +0100
Subject: [PATCH] * lisp/subr.el (buffer-match-p): Optimise performance

---
 lisp/subr.el | 75 +++++++++++++++++++++++++++-------------------------
 1 file changed, 39 insertions(+), 36 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 83e2e75c41..0dd7a814d9 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -7002,8 +7002,38 @@ string-lines
             (setq start (length string)))))
       (nreverse lines))))
 
-(defun buffer-match-p (condition buffer-or-name &optional arg)
-  "Return non-nil if BUFFER-OR-NAME matches CONDITION.
+(letrec ((buffer-sym (make-symbol "buffer"))
+         (arg-sym (make-symbol "arg"))
+         (translate
+          (lambda (condition)
+            "Compile a CONDITION into a predicate function."
+            (pcase-exhaustive condition
+              ((or 't 'nil)
+               condition)
+              ((pred stringp)
+               `(string-match-p ,condition (buffer-name ,buffer-sym)))
+              ((pred functionp)
+               (if (eq 1 (cdr (func-arity condition)))
+                   `(condition ,buffer-sym)
+                 `(condition
+                   ,buffer-sym
+                   ,arg-sym)))
+              (`(major-mode . ,mode)
+               `(eq (buffer-local-value 'major-mode ,buffer-sym)
+                    ',mode))
+              (`(derived-mode . ,mode)
+               `(provided-mode-derived-p
+                 (buffer-local-value 'major-mode ,buffer-sym)
+                 ',mode))
+              (`(not . ,cond)
+               `(not ,(funcall translate cond)))
+              (`(or . ,conds)
+               `(or ,@(mapcar translate conds)))
+              (`(and . ,conds)
+               `(and ,@(mapcar translate conds))))))
+         (cond-cache (make-hash-table :test 'eq)))
+  (defun buffer-match-p (condition buffer-or-name &optional arg)
+    "Return non-nil if BUFFER-OR-NAME matches CONDITION.
 CONDITION is either:
 - the symbol t, to always match,
 - the symbol nil, which never matches,
@@ -7022,40 +7052,13 @@ buffer-match-p
     to be met.
   * `or': the cdr is a list of recursive condition, of which at
     least one has to be met."
-  (letrec
-      ((buffer (get-buffer buffer-or-name))
-       (match
-        (lambda (conditions)
-          (catch 'match
-            (dolist (condition conditions)
-              (when (pcase condition
-                      ('t t)
-                      ((pred stringp)
-                       (string-match-p condition (buffer-name buffer)))
-                      ((pred functionp)
-                       (if (eq 1 (cdr (func-arity condition)))
-                           (funcall condition buffer)
-                         (funcall condition buffer arg)))
-                      (`(major-mode . ,mode)
-                       (eq
-                        (buffer-local-value 'major-mode buffer)
-                        mode))
-                      (`(derived-mode . ,mode)
-                       (provided-mode-derived-p
-                        (buffer-local-value 'major-mode buffer)
-                        mode))
-                      (`(not . ,cond)
-                       (not (funcall match cond)))
-                      (`(or . ,args)
-                       (funcall match args))
-                      (`(and . ,args)
-                       (catch 'fail
-                         (dolist (c args)
-                           (unless (funcall match (list c))
-                             (throw 'fail nil)))
-                         t)))
-                (throw 'match t)))))))
-    (funcall match (list condition))))
+    (funcall (or (gethash condition cond-cache)
+                 (puthash condition
+                          (byte-compile
+                           `(lambda (,buffer-sym ,arg-sym)
+                              ,(funcall translate condition)))
+                          cond-cache))
+             (get-buffer buffer-or-name) arg)))
 
 (defun match-buffers (condition &optional buffers arg)
   "Return a list of buffers that match CONDITION.
-- 
2.38.0