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:
Stefan Monnier 2017-03-15 22:48:28 -04:00 committed by Lars Brinkhoff
parent 0565482838
commit 8e6f204f44
7 changed files with 35 additions and 49 deletions

View file

@ -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

View file

@ -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

View file

@ -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)))

View file

@ -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 ()))

View file

@ -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'."

View file

@ -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)))

View file

@ -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)