Faster and less recursive byte-compile--first-symbol-with-pos

* lisp/emacs-lisp/bytecomp.el (byte-compile--first-symbol-with-pos)
(byte-compile--warning-source-offset):
Remove recursion for cdr-traversal of lists, and optimise (bug#55414).
This commit is contained in:
Mattias Engdegård 2022-05-26 17:19:45 +02:00
parent e490b80a10
commit e05acb07d3

View file

@ -1181,39 +1181,34 @@ message buffer `default-directory'."
(if (< (length f2) (length f1)) f2 f1))) (if (< (length f2) (length f1)) f2 f1)))
(defun byte-compile--first-symbol-with-pos (form) (defun byte-compile--first-symbol-with-pos (form)
"Return the \"first\" symbol with position found in form, or 0 if none. "Return the first symbol with position in form, or nil if none.
Here, \"first\" is by a depth first search." Order is by depth-first search."
(let (sym)
(cond (cond
((symbol-with-pos-p form) form) ((symbol-with-pos-p form) form)
((consp form) ((consp form)
(or (and (symbol-with-pos-p (setq sym (byte-compile--first-symbol-with-pos (car form)))) (or (byte-compile--first-symbol-with-pos (car form))
sym) (let ((sym nil))
(and (symbolp (setq sym (byte-compile--first-symbol-with-pos (cdr form)))) (setq form (cdr form))
sym) (while (and (consp form)
0)) (not (setq sym (byte-compile--first-symbol-with-pos
((and (or (vectorp form) (recordp form)) (car form)))))
(> (length form) 0)) (setq form (cdr form)))
(let ((i 0) (or sym
(len (length form)) (and form (byte-compile--first-symbol-with-pos form))))))
elt) ((vectorp form)
(catch 'sym (let ((len (length form))
(while (< i len) (i 0)
(when (symbol-with-pos-p (sym nil))
(setq elt (byte-compile--first-symbol-with-pos (aref form i)))) (while (and (< i len)
(throw 'sym elt)) (not (setq sym (byte-compile--first-symbol-with-pos
(aref form i)))))
(setq i (1+ i))) (setq i (1+ i)))
0))) sym))))
(t 0))))
(defun byte-compile--warning-source-offset () (defun byte-compile--warning-source-offset ()
"Return a source offset from `byte-compile-form-stack'. "Return a source offset from `byte-compile-form-stack' or nil if none."
Return nil if such is not found." (let ((sym (byte-compile--first-symbol-with-pos byte-compile-form-stack)))
(catch 'offset (and sym (symbol-with-pos-pos sym))))
(dolist (form byte-compile-form-stack)
(let ((s (byte-compile--first-symbol-with-pos form)))
(if (symbol-with-pos-p s)
(throw 'offset (symbol-with-pos-pos s)))))))
;; This is used as warning-prefix for the compiler. ;; This is used as warning-prefix for the compiler.
;; It is always called with the warnings buffer current. ;; It is always called with the warnings buffer current.