Re: User-defined record types, v2

[Lars Brinkhoff <lars@nocrew.org>]

Make EIEIO use records.

* lisp/emacs-lisp/eieio-core.el: Use records, and place the class object
directly as tag.
(eieio--object-class): Adjust to new tag representation.
(eieio-object-p): Rewrite.
(eieio-defclass-internal): Use `make-record'.
(eieio--generic-generalizer): Adjust generalizer code accordingly.

* lisp/emacs-lisp/eieio.el (make-instance, clone): Use copy-record.

* lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
Add `recordp'.

diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 5cc6d02..882e7fb 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -122,7 +122,7 @@ eieio-default-superclass
     (length (cl-struct-slot-info 'eieio--object))))
 
 (defsubst eieio--object-class (obj)
-  (symbol-value (eieio--object-class-tag obj)))
+  (eieio--object-class-tag obj))
 
 \f
 ;;; Important macros used internally in eieio.
@@ -166,13 +166,7 @@ eieio--class-option
 
 (defun eieio-object-p (obj)
   "Return non-nil if OBJ is an EIEIO object."
-  (and (vectorp obj)
-       (> (length obj) 0)
-       (let ((tag (eieio--object-class-tag obj)))
-         (and (symbolp tag)
-              ;; (eq (symbol-function tag) :quick-object-witness-check)
-              (boundp tag)
-              (eieio--class-p (symbol-value tag))))))
+  (eieio--class-p (type-of obj)))
 
 (define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
 
@@ -496,18 +490,10 @@ eieio-defclass-internal
     (if clearparent (setf (eieio--class-parents newc) nil))
 
     ;; Create the cached default object.
-    (let ((cache (make-vector (+ (length (eieio--class-slots newc))
+    (let ((cache (make-record newc
+                              (+ (length (eieio--class-slots newc))
                                  (eval-when-compile eieio--object-num-slots))
-                              nil))
-          ;; We don't strictly speaking need to use a symbol, but the old
-          ;; code used the class's name rather than the class's object, so
-          ;; we follow this preference for using a symbol, which is probably
-          ;; convenient to keep the printed representation of such Elisp
-          ;; objects readable.
-          (tag (intern (format "eieio-class-tag--%s" cname))))
-      (set tag newc)
-      (fset tag :quick-object-witness-check)
-      (setf (eieio--object-class-tag cache) tag)
+                              nil)))
       (let ((eieio-skip-typecheck t))
 	;; All type-checking has been done to our satisfaction
 	;; before this call.  Don't waste our time in this call..
@@ -1060,9 +1046,9 @@ 'inconsistent-class-hierarchy
   ;; part of the dispatch code.
   50 #'cl--generic-struct-tag
   (lambda (tag &rest _)
-    (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))
+    (and (eieio--class-p tag)
          (mapcar #'eieio--class-name
-                 (eieio--class-precedence-list (symbol-value tag))))))
+                 (eieio--class-precedence-list tag)))))
 
 (cl-defmethod cl-generic-generalizers :extra "class" (specializer)
   "Support for dispatch on types defined by EIEIO's `defclass'."
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1a6d5e9..f3530ca 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -701,8 +701,8 @@ 'constructor
 This static method is called when an object is constructed.
 It allocates the vector used to represent an EIEIO object, and then
 calls `initialize-instance' on that object."
-  (let* ((new-object (copy-sequence (eieio--class-default-object-cache
-                                     (eieio--class-object class)))))
+  (let* ((new-object (copy-record (eieio--class-default-object-cache
+                                   (eieio--class-object class)))))
     (if (and slots
              (let ((x (car slots)))
                (or (stringp x) (null x))))
@@ -806,7 +806,7 @@ 'constructor
 
 (cl-defmethod clone ((obj eieio-default-superclass) &rest params)
   "Make a copy of OBJ, and then apply PARAMS."
-  (let ((nobj (copy-sequence obj)))
+  (let ((nobj (copy-record obj)))
     (if (stringp (car params))
         (funcall (if eieio-backward-compatibility #'ignore #'message)
                  "Obsolete name %S passed to clone" (pop params)))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 289265a..6c4ac51 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -503,24 +503,30 @@ pcase-mutually-exclusive-predicates
     (symbolp . vectorp)
     (symbolp . stringp)
     (symbolp . byte-code-function-p)
+    (symbolp . recordp)
     (integerp . consp)
     (integerp . arrayp)
     (integerp . vectorp)
     (integerp . stringp)
     (integerp . byte-code-function-p)
+    (integerp . recordp)
     (numberp . consp)
     (numberp . arrayp)
     (numberp . vectorp)
     (numberp . stringp)
     (numberp . byte-code-function-p)
+    (numberp . recordp)
     (consp . arrayp)
     (consp . atom)
     (consp . vectorp)
     (consp . stringp)
     (consp . byte-code-function-p)
+    (consp . recordp)
     (arrayp . byte-code-function-p)
     (vectorp . byte-code-function-p)
+    (vectorp . recordp)
     (stringp . vectorp)
+    (stringp . recordp)
     (stringp . byte-code-function-p)))
 
 (defun pcase--mutually-exclusive-p (pred1 pred2)