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