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.
This commit is contained in:
parent
0565482838
commit
8e6f204f44
7 changed files with 35 additions and 49 deletions
|
@ -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
|
||||
|
|
|
@ -1017,7 +1017,7 @@ If @var{errorp} is non-@code{nil}, @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
|
||||
|
||||
|
|
|
@ -294,8 +294,7 @@ Second, any text properties will be stripped from strings."
|
|||
(cond ((consp proposed-value)
|
||||
;; Lists with something in them need special treatment.
|
||||
(let* ((slot-idx (- (eieio--slot-name-index class slot)
|
||||
(eval-when-compile
|
||||
(length (cl-struct-slot-info 'eieio--object)))))
|
||||
(eval-when-compile eieio--object-num-slots)))
|
||||
(type (cl--slot-descriptor-type (aref (eieio--class-slots class)
|
||||
slot-idx)))
|
||||
(classtype (eieio-persistent-slot-type-is-class-p type)))
|
||||
|
|
|
@ -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 ()))
|
||||
|
|
|
@ -108,21 +108,14 @@ Currently under control of this var:
|
|||
(cl-declaim (optimize (safety 1))))
|
||||
|
||||
|
||||
(cl-defstruct (eieio--object
|
||||
(:type vector) ;We manage our own tagging system.
|
||||
(:constructor nil)
|
||||
(:copier nil))
|
||||
;; `class-tag' holds a symbol, which is not the class name, but is instead
|
||||
;; properly prefixed as an internal EIEIO thingy and which holds the class
|
||||
;; object/struct in its `symbol-value' slot.
|
||||
class-tag)
|
||||
(eval-and-compile
|
||||
(defconst eieio--object-num-slots 1))
|
||||
|
||||
(eval-when-compile
|
||||
(defconst eieio--object-num-slots
|
||||
(length (cl-struct-slot-info 'eieio--object))))
|
||||
(defsubst eieio--object-class-tag (obj)
|
||||
(aref obj 0))
|
||||
|
||||
(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 +159,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 +484,11 @@ 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))
|
||||
(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)
|
||||
(let ((cache (make-record newc
|
||||
(+ (length (eieio--class-slots newc))
|
||||
(eval-when-compile eieio--object-num-slots)
|
||||
-1)
|
||||
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 +1041,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'."
|
||||
|
|
|
@ -337,14 +337,12 @@ variable name of the same name as the slot."
|
|||
;; hard-coded in random .elc files.
|
||||
(defun eieio-pcase-slot-index-table (obj)
|
||||
"Return some data structure from which can be extracted the slot offset."
|
||||
(eieio--class-index-table
|
||||
(symbol-value (eieio--object-class-tag obj))))
|
||||
(eieio--class-index-table (eieio--object-class obj)))
|
||||
|
||||
(defun eieio-pcase-slot-index-from-index-table (index-table slot)
|
||||
"Find the index to pass to `aref' to access SLOT."
|
||||
(let ((index (gethash slot index-table)))
|
||||
(if index (+ (eval-when-compile
|
||||
(length (cl-struct-slot-info 'eieio--object)))
|
||||
(if index (+ (eval-when-compile eieio--object-num-slots)
|
||||
index))))
|
||||
|
||||
(pcase-defmacro eieio (&rest fields)
|
||||
|
@ -701,8 +699,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 +804,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)))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Reference in a new issue