]> git.eshelyaron.com Git - emacs.git/commitdiff
(defclass): Don't duplicate the compiler macro
authorStefan Monnier <monnier@iro.umontreal.ca>
Fri, 4 Apr 2025 20:48:57 +0000 (16:48 -0400)
committerEshel Yaron <me@eshelyaron.com>
Tue, 8 Apr 2025 05:41:07 +0000 (07:41 +0200)
* lisp/emacs-lisp/eieio.el (eieio--constructor-macro): New function.
(defclass): Use it.

(cherry picked from commit 21920da6c73a8bccd06baadc8aa75e4b820ab849)

lisp/emacs-lisp/eieio.el

index 483234f9434289c08c9565ef424f5d1a44cf7db0..e84ad6f670efbbfa7fa5e2dac23d73c4a4be5e09 100644 (file)
@@ -289,20 +289,22 @@ and reference them using the function `class-option'."
           `(defun ,name (&rest slots)
              ,(internal--format-docstring-line
                "Create a new object of class type `%S'." name)
-             (declare (compiler-macro
-                       (lambda (whole)
-                         (if (not (stringp (car slots)))
-                             whole
-                           (macroexp-warn-and-return
-                            (format "Obsolete name arg %S to constructor %S"
-                                    (car slots) (car whole))
-                            ;; Keep the name arg, for backward compatibility,
-                            ;; but hide it so we don't trigger indefinitely.
-                            `(,(car whole) (identity ,(car slots))
-                              ,@(cdr slots))
-                            nil nil (car slots))))))
+             (declare (compiler-macro eieio--constructor-macro))
              (apply #'make-instance ',name slots))))))
 
+(defun eieio--constructor-macro (whole &rest slots)
+  (if (or (null slots) (keywordp (car slots))
+          ;; Detect the second pass!
+          (eq 'identity (car-safe (car slots))))
+      whole
+    (macroexp-warn-and-return
+     (format "Obsolete name arg %S to constructor %S"
+             (car slots) (car whole))
+     ;; Keep the name arg, for backward compatibility,
+     ;; but hide it so we don't trigger indefinitely.
+     `(,(car whole) (identity ,(car slots))
+       ,@(cdr slots))
+     nil nil (car slots))))
 
 ;;; Get/Set slots in an object.
 ;;