[Emacs-diffs] scratch/record 5b99c91e 3/5: Make EIEIO use records.

[Lars Brinkhoff]

branch: scratch/record
commit 5b99c91e56a7d171b27b4d0c86c2116b2d83516b
Author: Stefan Monnier <address@hidden>
Commit: Lars Brinkhoff <address@hidden>

    Make EIEIO use records.
    
    * lisp/emacs-lisp/eieio-compat.el
    (eieio--generic-static-object-generalizer): Adjust to new tags.
    
    * 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, and adapt to new `type-of' behavior.
    (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'.
    
    * doc/lispref/records.texi, doc/misc/eieio.texi: Update for records.
---
 doc/lispref/records.texi        |  3 ++-
 doc/misc/eieio.texi             | 10 +++++-----
 lisp/emacs-lisp/eieio-compat.el |  2 +-
 lisp/emacs-lisp/eieio-core.el   | 34 +++++++++++-----------------------
 lisp/emacs-lisp/eieio.el        |  6 +++---
 lisp/emacs-lisp/pcase.el        |  6 ++++++
 6 files changed, 28 insertions(+), 33 deletions(-)

diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi
index ae67a9b..6af7dab 100644
--- a/doc/lispref/records.texi
+++ b/doc/lispref/records.texi
@@ -9,7 +9,8 @@
 
   The purpose of records is to allow programmers to create objects
 with new types that are not built into Emacs.  They are used as the
-underlying representation of @code{cl-defstruct} instances.
+underlying representation of @code{cl-defstruct} and @code{defclass}
+instances.
 
   Internally, a record object is much like a vector; its slots can be
 accessed using @code{aref}.  However, the first slot is used to hold
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index dfae565..b0b7b4d 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -265,7 +265,7 @@ To create a new class, use the @code{defclass} macro:
 
 @defmac defclass class-name superclass-list slot-list &rest options-and-doc
 
-Create a new class named @var{class-name}.  The class is represented
+Create a new class named @var{class-name}.  XXX  The class is represented
 by a symbol with the name @var{class-name}.  @eieio{} stores the structure of
 the class as a symbol property of @var{class-name} (@pxref{Symbol
 Components,,,elisp,GNU Emacs Lisp Reference Manual}).
@@ -1017,7 +1017,7 @@ If @var{errorp} is address@hidden, 
@code{wrong-argument-type} is signaled.
 
 @defun class-p class
 @anchor{class-p}
-Return @code{t} if @var{class} is a valid class vector.
+Return @code{t} if @var{class} is a valid class object.
 @var{class} is a symbol.
 @end defun
 
@@ -1055,7 +1055,7 @@ Will fetch the documentation string for 
@code{eieio-default-superclass}.
 Return a string of the form @samp{#<object-class myobjname>} for @var{obj}.
 This should look like Lisp symbols from other parts of Emacs such as
 buffers and processes, and is shorter and cleaner than printing the
-object's vector.  It is more useful to use @code{object-print} to get
+object's record.  It is more useful to use @code{object-print} to get
 and object's print form, as this allows the object to add extra display
 information into the symbol.
 @end defun
@@ -1212,7 +1212,7 @@ items defined in this second slot.
 
 Introspection permits a programmer to peek at the contents of a class
 without any previous knowledge of that class.  While @eieio{} implements
-objects on top of vectors, and thus everything is technically visible,
+objects on top of records, and thus everything is technically visible,
 some functions have been provided.  None of these functions are a part
 of CLOS.
 
@@ -1525,7 +1525,7 @@ Currently, the default superclass is defined as follows:
   nil
   "Default parent class for classes with no specified parent class.
 Its slots are automatically adopted by classes with no specified
-parents.  This class is not stored in the `parent' slot of a class vector."
+parents.  This class is not stored in the `parent' slot of a class object."
   :abstract t)
 @end example
 
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index 888d85f..d6eb0b4 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -145,7 +145,7 @@ Summary:
   ;; interleaved list comes before the class's non-interleaved list.
   51 #'cl--generic-struct-tag
   (lambda (tag &rest _)
-    (and (symbolp tag) (boundp tag) (setq tag (symbol-value tag))
+    (and (symbolp tag) (setq tag (cl--find-class tag))
          (eieio--class-p tag)
          (let ((superclasses (eieio--class-precedence-list tag))
                (specializers ()))
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 5cc6d02..2bc8c03 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -109,7 +109,7 @@ Currently under control of this var:
 
 
 (cl-defstruct (eieio--object
-               (:type vector)           ;We manage our own tagging system.
+               (:type vector) ;; FIXME!  ;We manage our own tagging system.
                (:constructor nil)
                (:copier nil))
   ;; `class-tag' holds a symbol, which is not the class name, but is instead
@@ -122,7 +122,7 @@ Currently under control of this var:
     (length (cl-struct-slot-info 'eieio--object))))
 
 (defsubst eieio--object-class (obj)
-  (symbol-value (eieio--object-class-tag obj)))
+  (eieio--object-class-tag obj))
 
 
 ;;; Important macros used internally in eieio.
@@ -166,13 +166,8 @@ Return nil if that option doesn't exist."
 
 (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))))))
+  (and (recordp obj)
+       (eieio--class-p (eieio--object-class-tag obj))))
 
 (define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
 
@@ -496,18 +491,10 @@ See `defclass' for more information."
     (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 +1047,10 @@ method invocation orders of the involved classes."
   ;; part of the dispatch code.
   50 #'cl--generic-struct-tag
   (lambda (tag &rest _)
-    (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))
-         (mapcar #'eieio--class-name
-                 (eieio--class-precedence-list (symbol-value tag))))))
+    (let ((class (cl--find-class tag)))
+      (and (eieio--class-p class)
+           (mapcar #'eieio--class-name
+                   (eieio--class-precedence-list class))))))
 
 (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 @@ SLOTS are the initialization slots used by 
`initialize-instance'.
 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 @@ first and modify the returned object.")
 
 (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 fc5474e..4a06ab2 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -503,24 +503,30 @@ MATCH is the pattern that needs to be matched, of the 
form:
     (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)