mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
Make cl-defstruct use records.
* lisp/emacs-lisp/cl-extra.el (cl--describe-class) (cl--describe-class-slots): Use the new `type-of'. * lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): Use type-of. (cl--generic-struct-specializers): Adjust to new tag. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): When type is nil, use records. Use the type symbol as the tag. Use copy-record to copy structs. (cl--defstruct-predicate): New function. (cl--pcase-mutually-exclusive-p): Use it. (cl-struct-sequence-type): Can now return `record'. * lisp/emacs-lisp/cl-preloaded.el (cl--make-slot-desc): Adjust ad-hoc code to new format. (cl--struct-register-child): Work with records. (cl-struct-define): Don't touch the tag's symbol-value and symbol-function slots when we use the type as tag. * lisp/emacs-lisp/cl-print.el (cl-print-object): Adjust to new tag. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-defstruct-record): New test. * doc/lispref/records.texi, doc/misc/cl.texi: Update for records.
This commit is contained in:
parent
a2c3343029
commit
0565482838
8 changed files with 87 additions and 74 deletions
|
|
@ -1082,24 +1082,8 @@ These match if the argument is `eql' to VAL."
|
|||
;;; Support for cl-defstructs specializers.
|
||||
|
||||
(defun cl--generic-struct-tag (name &rest _)
|
||||
;; It's tempting to use (and (vectorp ,name) (aref ,name 0))
|
||||
;; but that would suffer from some problems:
|
||||
;; - the vector may have size 0.
|
||||
;; - when called on an actual vector (rather than an object), we'd
|
||||
;; end up returning an arbitrary value, possibly colliding with
|
||||
;; other tagcode's values.
|
||||
;; - it can also result in returning all kinds of irrelevant
|
||||
;; values which would end up filling up the method-cache with
|
||||
;; lots of irrelevant/redundant entries.
|
||||
;; FIXME: We could speed this up by introducing a dedicated
|
||||
;; vector type at the C level, so we could do something like
|
||||
;; (and (vector-objectp ,name) (aref ,name 0))
|
||||
`(and (vectorp ,name)
|
||||
(> (length ,name) 0)
|
||||
(let ((tag (aref ,name 0)))
|
||||
(and (symbolp tag)
|
||||
(eq (symbol-function tag) :quick-object-witness-check)
|
||||
tag))))
|
||||
;; Use exactly the same code as for `typeof'.
|
||||
`(if ,name (type-of ,name) 'null))
|
||||
|
||||
(defun cl--generic-class-parents (class)
|
||||
(let ((parents ())
|
||||
|
|
@ -1113,8 +1097,8 @@ These match if the argument is `eql' to VAL."
|
|||
(nreverse parents)))
|
||||
|
||||
(defun cl--generic-struct-specializers (tag &rest _)
|
||||
(and (symbolp tag) (boundp tag)
|
||||
(let ((class (symbol-value tag)))
|
||||
(and (symbolp tag)
|
||||
(let ((class (get tag 'cl--class)))
|
||||
(when (cl-typep class 'cl-structure-class)
|
||||
(cl--generic-class-parents class)))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue