1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -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:
Lars Brinkhoff 2017-03-14 13:52:40 +01:00
parent a2c3343029
commit 0565482838
8 changed files with 87 additions and 74 deletions

View file

@ -775,8 +775,7 @@ including `cl-block' and `cl-eval-when'."
(defun cl--describe-class (type &optional class)
(unless class (setq class (cl--find-class type)))
(let ((location (find-lisp-object-file-name type 'define-type))
;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch.
(metatype (cl--class-name (symbol-value (aref class 0)))))
(metatype (type-of class)))
(insert (symbol-name type)
(substitute-command-keys " is a type (of kind `"))
(help-insert-xref-button (symbol-name metatype)
@ -901,8 +900,7 @@ including `cl-block' and `cl-eval-when'."
"Print help description for the slots in CLASS.
Outputs to the current buffer."
(let* ((slots (cl--class-slots class))
;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch.
(metatype (cl--class-name (symbol-value (aref class 0))))
(metatype (type-of class))
;; ¡For EIEIO!
(cslots (condition-case nil
(cl-struct-slot-value metatype 'class-slots class)