Subject: Dropping EIEIO from xref (for performance)
From: Dmitry Gutov <[email-masked]>
To: [email-masked]
Date: Fri, 24 Sep 2021 16:28:38 +0300
List-Id: <debbugs-submit.debbugs.gnu.org>

X-Debbugs-CC: Eli Zaretskii <[email-masked]>, Lars Ingebrigtsen 
<[email-masked]>, Stefan Monnier <[email-masked]>, Daniel 
Martín <[email-masked]>, Mattias Engdegård <[email-masked]>

With the recent discussion about our Lisp overhead when the search 
returns many matches, I went a couple more rounds to try to identify the 
hotspots.

My main benchmark for that is

   (benchmark 1 '(project-find-regexp "list"))

in the Emacs repo. The 3 recent commits have reduced that time from 8s 
to 6.5s on my machine (under best conditions: warm disk cache and fresh 
Emacs session). The machine is pretty fast, so I figure we can multiply 
that timing by 2x, to imagine the average user experience.

Having exhausted the obvious steps, I have looked at the difference 
between defclass and cl-defstruct in this respect. Earlier quick tests 
indicated there would be little to no difference, but now that I've 
wrote the full patch, it's significant.

The attached patch drops the timing of the above benchmark further down 
to 4.1s here.

Both allocation ('make-instance' vs auto-generated 'xref-make-*' struct 
constructors) and accessing the fields show increased performance, with 
the former showing the most improvement: I guess EIEIO's type checking 
added some extra overhead.

That creates some incompatibility (third-party packages can't inherit 
from 'xref-location' anymore, or use 'make-instance', 'oref' or 
'with-slots' with our values), but OTOH a quick survey of existing 
packages that integrate with Xref shows they wisely don't do that 
already. Not the largest, popular ones I have reviewed, at least.

The ones that do can be updated to rely on the recommended public 
interface: the xref-make-* constructors and the generic functions to 
access the data. This will keep the code compatible with both new and 
previous versions of Xref.

I'd like to push it soon, so users of Emacs 28 can enjoy the speedup.

What do people think?
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index e6af2b12c7..f53b09d9e8 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2161,18 +2161,16 @@ etags--xref-apropos-additional
          (nreverse res))))
    tags-apropos-additional-actions))
 
-(defclass xref-etags-location (xref-location)
-  ((tag-info :type list   :initarg :tag-info)
-   (file     :type string :initarg :file
-             :reader xref-location-group))
-  :documentation "Location of an etags tag.")
+(cl-defstruct (xref-etags-location
+               (:constructor xref-make-etags-location (tag-info file)))
+  "Location of an etags tag."
+  tag-info file)
 
-(defun xref-make-etags-location (tag-info file)
-  (make-instance 'xref-etags-location :tag-info tag-info
-                 :file (expand-file-name file)))
+(cl-defmethod xref-location-group ((l xref-etags-location))
+  (xref-etags-location-file l))
 
 (cl-defmethod xref-location-marker ((l xref-etags-location))
-  (with-slots (tag-info file) l
+  (pcase-let (((cl-struct xref-etags-location tag-info file) l))
     (let ((buffer (find-file-noselect file)))
       (with-current-buffer buffer
         (save-excursion
@@ -2182,25 +2180,20 @@ xref-location-marker
             (point-marker)))))))
 
 (cl-defmethod xref-location-line ((l xref-etags-location))
-  (with-slots (tag-info) l
+  (pcase-let (((cl-struct xref-etags-location tag-info) l))
     (nth 1 tag-info)))
 
-(defclass xref-etags-apropos-location (xref-location)
-  ((symbol :type symbol :initarg :symbol)
-   (goto-fun :type function :initarg :goto-fun)
-   (group :type string :initarg :group
-          :reader xref-location-group))
-  :documentation "Location of an additional apropos etags symbol.")
+(cl-defstruct (xref-etags-apropos-location
+               (:constructor xref-make-etags-apropos-location (symbol goto-fun group)))
+  "Location of an additional apropos etags symbol."
+  symbol goto-fun group)
 
-(defun xref-make-etags-apropos-location (symbol goto-fun group)
-  (make-instance 'xref-etags-apropos-location
-                 :symbol symbol
-                 :goto-fun goto-fun
-                 :group group))
+(cl-defmethod xref-location-group ((l xref-etags-apropos-location))
+  (xref-etags-apropos-location-group l))
 
 (cl-defmethod xref-location-marker ((l xref-etags-apropos-location))
   (save-window-excursion
-    (with-slots (goto-fun symbol) l
+    (pcase-let (((cl-struct xref-etags-apropos-location goto-fun symbol) l))
       (funcall goto-fun symbol)
       (point-marker))))
 
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index fb8090cfb7..fa053bc987 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -78,9 +78,6 @@ xref
 
 ;;; Locations
 
-(defclass xref-location () ()
-  :documentation "A location represents a position in a file or buffer.")
-
 (cl-defgeneric xref-location-marker (location)
   "Return the marker for LOCATION.")
 
@@ -121,19 +118,20 @@ xref-file-name-display
 
 ;; FIXME: might be useful to have an optional "hint" i.e. a string to
 ;; search for in case the line number is slightly out of date.
-(defclass xref-file-location (xref-location)
-  ((file :type string :initarg :file :reader xref-location-group)
-   (line :type fixnum :initarg :line :reader xref-location-line)
-   (column :type fixnum :initarg :column :reader xref-file-location-column))
-  :documentation "A file location is a file/line/column triple.
-Line numbers start from 1 and columns from 0.")
+(cl-defstruct (xref-file-location
+               (:constructor xref-make-file-location (file line column)))
+  "A file location is a file/line/column triple.
+Line numbers start from 1 and columns from 0."
+  file line column)
+
+(cl-defmethod xref-location-group ((l xref-file-location))
+  (xref-file-location-file l))
 
-(defun xref-make-file-location (file line column)
-  "Create and return a new `xref-file-location'."
-  (make-instance 'xref-file-location :file file :line line :column column))
+(cl-defmethod xref-location-line ((l xref-file-location))
+  (xref-file-location-line l))
 
 (cl-defmethod xref-location-marker ((l xref-file-location))
-  (with-slots (file line column) l
+  (pcase-let (((cl-struct xref-file-location file line column) l))
     (with-current-buffer
         (or (get-file-buffer file)
             (let ((find-file-suppress-same-file-warnings t))
@@ -151,77 +149,45 @@ xref-location-marker
             (forward-char column))
           (point-marker))))))
 
-(defclass xref-buffer-location (xref-location)
-  ((buffer :type buffer :initarg :buffer)
-   (position :type fixnum :initarg :position)))
-
-(defun xref-make-buffer-location (buffer position)
-  "Create and return a new `xref-buffer-location'."
-  (make-instance 'xref-buffer-location :buffer buffer :position position))
+(cl-defstruct (xref-buffer-location
+               (:constructor xref-make-buffer-location (buffer position)))
+  buffer position)
 
 (cl-defmethod xref-location-marker ((l xref-buffer-location))
-  (with-slots (buffer position) l
+  (pcase-let (((cl-struct xref-buffer-location buffer position) l))
     (let ((m (make-marker)))
       (move-marker m position buffer))))
 
 (cl-defmethod xref-location-group ((l xref-buffer-location))
-  (with-slots (buffer) l
+  (pcase-let (((cl-struct xref-buffer-location buffer) l))
     (or (buffer-file-name buffer)
         (format "(buffer %s)" (buffer-name buffer)))))
 
-(defclass xref-bogus-location (xref-location)
-  ((message :type string :initarg :message
-            :reader xref-bogus-location-message))
-  :documentation "Bogus locations are sometimes useful to
-indicate errors, e.g. when we know that a function exists but the
-actual location is not known.")
-
-(defun xref-make-bogus-location (message)
-  "Create and return a new `xref-bogus-location'."
-  (make-instance 'xref-bogus-location :message message))
+(cl-defstruct (xref-bogus-location
+               (:constructor xref-make-bogus-location (message)))
+  "Bogus locations are sometimes useful to indicate errors,
+e.g. when we know that a function exists but the actual location
+is not known."
+  message)
 
 (cl-defmethod xref-location-marker ((l xref-bogus-location))
-  (user-error "%s" (oref l message)))
+  (user-error "%s" (xref-bogus-location-message l)))
 
 (cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
 
 
 ;;; Cross-reference
 
-(defclass xref-item ()
-  ((summary :type string :initarg :summary
-            :reader xref-item-summary
-            :documentation "One line which will be displayed for
-this item in the output buffer.")
-   (location :initarg :location
-             :reader xref-item-location
-             :documentation "An object describing how to navigate
-to the reference's target."))
-  :comment "An xref item describes a reference to a location
-somewhere.")
-
-(defun xref-make (summary location)
-  "Create and return a new `xref-item'.
-SUMMARY is a short string to describe the xref.
-LOCATION is an `xref-location'."
-  (make-instance 'xref-item :summary summary :location location))
-
-(defclass xref-match-item ()
-  ((summary :type string :initarg :summary
-            :reader xref-item-summary)
-   (location :initarg :location
-             :type xref-location
-             :reader xref-item-location)
-   (length :initarg :length :reader xref-match-length))
-  :comment "A match xref item describes a search result.")
-
-(defun xref-make-match (summary location length)
-  "Create and return a new `xref-match-item'.
-SUMMARY is a short string to describe the xref.
-LOCATION is an `xref-location'.
-LENGTH is the match length, in characters."
-  (make-instance 'xref-match-item :summary summary
-                 :location location :length length))
+(cl-defstruct (xref-item
+               (:constructor xref-make (summary location)))
+  "An xref item describes a reference to a location somewhere."
+  summary location)
+
+(cl-defstruct (xref-match-item
+               (:include xref-item)
+               (:constructor xref-make-match (summary location length)))
+  "A match xref item describes a search result."
+  length)
 
 
 ;;; API
@@ -970,7 +936,7 @@ xref--insert-xrefs
            for max-line-width =
            (cl-loop for xref in xrefs
                     maximize (let ((line (xref-location-line
-                                          (oref xref location))))
+                                          (xref-item-location xref))))
                                (and line (1+ (floor (log line 10))))))
            for line-format = (and max-line-width
                                   (format "%%%dd: " max-line-width))
@@ -985,7 +951,7 @@ xref--insert-xrefs
            (xref--insert-propertized '(face xref-file-header xref-group t)
                                      group "\n")
            (cl-loop for xref in xrefs do
-                    (with-slots (summary location) xref
+                    (pcase-let (((cl-struct xref-item summary location) xref))
                       (let* ((line (xref-location-line location))
                              (prefix
                               (cond
@@ -1206,22 +1172,23 @@ xref-show-definitions-completing-read
     (cl-loop for ((group . xrefs) . more1) on xref-alist
              do
              (cl-loop for (xref . more2) on xrefs do
-                      (with-slots (summary location) xref
-                        (let* ((line (xref-location-line location))
-                               (line-fmt
-                                (if line
-                                    (format #("%d:" 0 2 (face xref-line-number))
-                                            line)
-                                  ""))
-                               (group-prefix
-                                (substring group group-prefix-length))
-                               (group-fmt
-                                (propertize group-prefix
-                                            'face 'xref-file-header
-                                            'xref--group group-prefix))
-                               (candidate
-                                (format "%s:%s%s" group-fmt line-fmt summary)))
-                          (push (cons candidate xref) xref-alist-with-line-info)))))
+                      (let* ((summary (xref-item-summary xref))
+                             (location (xref-item-location xref))
+                             (line (xref-location-line location))
+                             (line-fmt
+                              (if line
+                                  (format #("%d:" 0 2 (face xref-line-number))
+                                          line)
+                                ""))
+                             (group-prefix
+                              (substring group group-prefix-length))
+                             (group-fmt
+                              (propertize group-prefix
+                                          'face 'xref-file-header
+                                          'xref--group group-prefix))
+                             (candidate
+                              (format "%s:%s%s" group-fmt line-fmt summary)))
+                        (push (cons candidate xref) xref-alist-with-line-info))))
 
     (setq xref (if (not (cdr xrefs))
                    (car xrefs)