From f20c20036f7c2e1d84c5f03e9e23f41372e416c5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 7 Mar 2024 16:58:15 -0500 Subject: [PATCH] Make "parentless" structs inherit from their builtin type * lisp/emacs-lisp/cl-preloaded.el (cl--struct-register-child): Register child only in struct parents. (cl-struct-define): Put the "type" as parent of parentless :type structs. Copy slots only from struct parent classes. (cl-structure-object): Set (manually) its parent to `record` and remove assertion that it has no parents. (cherry picked from commit 7c127fc965fbe781141a6bccbe0b620dc7862b1d) --- lisp/emacs-lisp/cl-preloaded.el | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 882b4b5939b..1b330e7f761 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -112,7 +112,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 (recordp parent) + (while (cl--struct-class-p 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 have one parent. @@ -127,9 +127,14 @@ (with-suppressed-warnings ((obsolete cl-old-struct-compat-mode)) (message "cl-old-struct-compat-mode is obsolete!") (cl-old-struct-compat-mode 1))) - (if (eq type 'record) - ;; Defstruct using record objects. - (setq type nil)) + (when (eq type 'record) + ;; Defstruct using record objects. + (setq type nil) + ;; `cl-structure-class' and `cl-structure-object' are allowed to be + ;; defined without specifying the parent, because their parent + ;; doesn't exist yet when they're defined. + (cl-assert (or parent (memq name '(cl-structure-class + cl-structure-object))))) (cl-assert (or type (not named))) (if (boundp children-sym) (add-to-list children-sym tag) @@ -137,7 +142,9 @@ (and (null type) (eq (caar slots) 'cl-tag-slot) ;; Hide the tag slot from "standard" (i.e. non-`type'd) structs. (setq slots (cdr slots))) - (let* ((parent-class (when parent (cl--struct-get-class parent))) + (let* ((parent-class (if parent (cl--struct-get-class parent) + (cl--find-class (if (eq type 'list) 'cons + (or type 'record))))) (n (length slots)) (index-table (make-hash-table :test 'eq :size n)) (vslots (let ((v (make-vector n nil)) @@ -160,7 +167,9 @@ name docstring (unless (symbolp parent-class) (list parent-class)) type named vslots index-table children-sym tag print))) - (unless (symbolp parent-class) + (cl-assert (or (not (symbolp parent-class)) + (memq name '(cl-structure-class cl-structure-object)))) + (when (cl--struct-class-p parent-class) (let ((pslots (cl--struct-class-slots parent-class))) (or (>= n (length pslots)) (let ((ok t)) @@ -417,6 +426,13 @@ For this build of Emacs it's %dbit." (cl--define-built-in-type subr-primitive (subr) "Type of functions hand written in C.") +(unless (cl--class-parents (cl--find-class 'cl-structure-object)) + ;; When `cl-structure-object' is created, built-in classes didn't exist + ;; yet, so we couldn't put `record' as the parent. + ;; Fix it now to close the recursion. + (setf (cl--class-parents (cl--find-class 'cl-structure-object)) + (list (cl--find-class 'record)))) + (defconst cl--direct-supertypes-of-type ;; Please run `sycdoc-update-type-hierarchy' in ;; `admin/syncdoc-type-hierarchy.el' each time this is modified to @@ -447,9 +463,6 @@ supertypes from the most specific to least specific.") (defconst cl--all-builtin-types (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) -(eval-and-compile - (cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object))))) - ;; Make sure functions defined with cl-defsubst can be inlined even in ;; packages which do not require CL. We don't put an autoload cookie ;; directly on that function, since those cookies only go to cl-loaddefs. -- 2.39.5