diff options
Diffstat (limited to 'lisp/emacs-lisp/cl-preloaded.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-preloaded.el | 27 |
1 files changed, 23 insertions, 4 deletions
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 4ae77a58ec9..ab6354de7cd 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -64,7 +64,7 @@ ;; cl--slot-descriptor. ;; BEWARE: Obviously, it's important to keep the two in sync! (lambda (name &optional initform type props) - (vector 'cl-struct-cl-slot-descriptor + (record 'cl-slot-descriptor name initform type props))) (defun cl--struct-get-class (name) @@ -101,7 +101,7 @@ (defun cl--struct-register-child (parent tag) ;; Can't use (cl-typep parent 'cl-structure-class) at this stage ;; because `cl-structure-class' is defined later. - (while (vectorp parent) + (while (recordp parent) (add-to-list (cl--struct-class-children-sym parent) tag) ;; Only register ourselves as a child of the leftmost parent since structs ;; can only only have one parent. @@ -110,6 +110,12 @@ ;;;###autoload (defun cl-struct-define (name docstring parent type named slots children-sym tag print) + (unless type + ;; Legacy defstruct, using tagged vectors. Enable backward compatibility. + (cl-old-struct-compat-mode 1)) + (if (eq type 'record) + ;; Defstruct using record objects. + (setq type nil)) (cl-assert (or type (not named))) (if (boundp children-sym) (add-to-list children-sym tag) @@ -150,8 +156,21 @@ parent name)))) (add-to-list 'current-load-list `(define-type . ,name)) (cl--struct-register-child parent-class tag) - (unless (eq named t) - (eval `(defconst ,tag ',class) t) + (unless (or (eq named t) (eq tag name)) + ;; We used to use `defconst' instead of `set' but that + ;; has a side-effect of purecopying during the dump, so that the + ;; class object stored in the tag ends up being a *copy* of the + ;; one stored in the `cl--class' property! We could have fixed + ;; this needless duplication by using the purecopied object, but + ;; that then breaks down a bit later when we modify the + ;; cl-structure-class class object to close the recursion + ;; between cl-structure-object and cl-structure-class (because + ;; modifying purecopied objects is not allowed. Since this is + ;; done during dumping, we could relax this rule and allow the + ;; modification, but it's cumbersome). + ;; So in the end, it's easier to just avoid the duplication by + ;; avoiding the use of the purespace here. + (set tag class) ;; In the cl-generic support, we need to be able to check ;; if a vector is a cl-struct object, without knowing its particular type. ;; So we use the (otherwise) unused function slots of the tag symbol |