1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

comp-cstr.el: The type hierarchy is a DAG, not a tree

Adjust the type operations to account for the fact that types can have
several parents.

* lisp/emacs-lisp/comp-cstr.el (comp--cl-class-hierarchy):
Use `cl--class-allparents`.  Add FIXME.
(comp--direct-supertype): Declare obsolete.
(comp--direct-supertypes): New function.
(comp--normalize-typeset0): Rewrite to use `comp--direct-supertypes`;
adjust to account for the DAG structure; use `cl-set-difference`.
(comp--direct-subtypes): Rewrite.
(comp--intersection): New function.
(comp-supertypes): Rewrite and change return type.
(comp-subtype-p): Simplify.
(comp-union-typesets): Use `comp-supertypes` instead of iterating over
`comp-cstr-ctxt-typeof-types`.
* lisp/emacs-lisp/comp.el (comp--native-compile): Don't catch
errors if we're debugging.
* test/lisp/emacs-lisp/comp-cstr-tests.el: Adjust tests.

* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Fix mishap when we
evaluate (cl-defstruct cl-structure-object ..) during the compilation
of `cl-preloaded.el`.
* lisp/emacs-lisp/cl-preloaded.el: Add corresponding assertion.
This commit is contained in:
Stefan Monnier 2023-10-30 00:59:19 -04:00
parent 271d8b70f8
commit bdec2d2d46
5 changed files with 112 additions and 72 deletions

View file

@ -3092,7 +3092,11 @@ To see the documentation for a defined struct type, use
descs)))
(t
(error "Structure option %s unrecognized" opt)))))
(unless (or include-name type)
(unless (or include-name type
;; Don't create a bogus parent to `cl-structure-object'
;; while compiling the (cl-defstruct cl-structure-object ..)
;; in `cl-preloaded.el'.
(eq name cl--struct-default-parent))
(setq include-name cl--struct-default-parent))
(when include-name (setq include (cl--struct-get-class include-name)))
(if print-func
@ -3331,7 +3335,7 @@ To see the documentation for a defined struct type, use
;;; Add cl-struct support to pcase
;;In use by comp.el
(defun cl--struct-all-parents (class)
(defun cl--struct-all-parents (class) ;FIXME: Merge with `cl--class-allparents'
(when (cl--struct-class-p class)
(let ((res ())
(classes (list class)))