GNU bug report logs - #77725
31.0.50; Add support for types accepted by `cl-typep' to cl-generic?

Previous Next

Full log

Message #149 received at 77725 <at> debbugs.gnu.org (full text, mbox):

From: Stefan Monnier <monnier <at> iro.umontreal.ca>
To: David Ponce <da_vid <at> orange.fr>
Cc: 77725 <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org>
Subject: Re: bug#77725: 31.0.50; Add support for types accepted by
 `cl-typep' to cl-generic?
Date: Tue, 29 Apr 2025 14:02:17 -0400

[Message part 1 (text/plain, inline)]

Further comments:

- For a declaration like

    (cl-deftype list-of (elem-type)
      `(and list
            (satisfies ,(lambda (list)
                          (cl-every (lambda (elem) (cl-typep elem elem-type))
                                    list)))))
    
  we add the type to `cl--type-list` even though it's unusable there
  (the `cl-typep` call in `cl-types-of` will always signal an error
  because the type can't be used without argument).

- Regarding incorporation into CL-Lib: apparently we don't need to
  `cl-deftype` in preloaded files, so `cl--type-deftype`
  does not have to be in `cl-preloaded`.
  But if `cl-deftype` expands to a call to it, then it needs to be
  (auto)loaded even when CL-Lib is not loaded, which suggests putting it
  into `cl-lib.el`.
  Another option would be to make `cl-deftype` expand to code which does
  not immediately call `cl--type-deftype`.  One way to do that would be to
  wrap the call into a `(with-eval-after-load 'cl-lib ...)` or
  something similar.

- One way to solve the problem with `list-of` (and even open up the
  possibility to dispatch on complex types like `(list-of FOO)`) is to
  populate `cl--type-dispatch-list` (i.e. the list of types that need to
  be checked during dispatch) from `cl-generic-generalizers` so it
  includes only those types for which there's a method, rather than all
  defined types.

- The dispatch of types defined by `cl-deftype` is inherently unreliable
  because the priority to use is not always the same.  For a type
  defined as `(or integer symbol)` the priority should be *lower* than
  the priority of the "typeof" generalizer, whereas for a type defined
  as `(list-of (eql 'a))` the priority should be higher than that of the
  "head" generalizer.
  I don't think we can solve this problem, but it should be clearly
  documented somewhere as a limitation.

See below my current local changes (not really related to the comments
above) as a diff w.r.t. the `scratch/cl-types` branch.


        Stefan

[cl-types.patch (text/x-diff, inline)]

diff --git a/lisp/emacs-lisp/cl-types.el b/lisp/emacs-lisp/cl-types.el
index c10ce4a24fb..02972e0b817 100644
--- a/lisp/emacs-lisp/cl-types.el
+++ b/lisp/emacs-lisp/cl-types.el
@@ -48,22 +48,12 @@ cl--type-p
 That is, a type defined by `cl-deftype', of class `cl-type-class'."
   (and (symbolp object) (cl-type-class-p (cl--find-class object))))
 
-(defsubst cl--type-parents (name)
+(defun cl--type-parents (name)
   "Get parents of type with NAME.
 NAME is a symbol representing a type.
 Return a possibly empty list of types."
   (cl--class-allparents (cl--find-class name)))
 
-(defsubst cl--type-children (name)
-  "Get children of the type with NAME.
-NAME is a symbol representing a type.
-Return a possibly empty list of types."
-  (cl--class-children (cl--find-class name)))
-
-(defsubst cl--type-dag (types)
-  "Return a DAG from the list of TYPES."
-  (mapcar #'cl--type-parents types))
-
 ;; Keep it for now, for testing.
 (defun cl--type-undefine (name)
   "Remove the definition of cl-type with NAME.
@@ -71,7 +61,7 @@ cl--type-undefine
 Signal an error if NAME has subtypes."
   (cl-check-type name (satisfies cl--type-p))
   (when-let* ((children (and (cl--type-p name)
-                             (cl--type-children name))))
+                             (cl--class-children (cl--find-class name)))))
     (error "Type has children: %S" children))
   (cl-remprop name 'cl--type-error)
   (cl-remprop name 'cl--class)
@@ -80,6 +70,8 @@ cl--type-undefine
 
 (defun cl--type-deftype (name parents &optional docstring)
   ;; FIXME: Should we also receive the arglist?
+  ;; FIXME: "Generalize" is not right, and the part related to
+  ;; method-dispatch is just that: a part.
   "Generalize cl-type with NAME for method dispatching.
 PARENTS is a list of types NAME is a subtype of, or nil.
 DOCSTRING is an optional documentation string."
@@ -105,22 +97,7 @@ cl--type-deftype
               ;; Clear any previous error mark.
               (cl-remprop name 'cl--type-error)
             ;; Record new type to include its dependency in the DAG.
-            (push name typelist))
-          ;; `cl-types-of' iterates through all known types to collect
-          ;; all those an object belongs to, sorted from the most
-          ;; specific type to the more general type.  So, keep the
-          ;; global list in this order.
-          ;; FIXME: This global operation is a bit worrisome, because it
-          ;; scales poorly with the number of types.  I guess it's OK
-          ;; for now because `cl-deftype' is not very popular, but it'll
-          ;; probably need to be replaced at some point.  Maybe we
-          ;; should simply require that the parents be defined already,
-          ;; then we can just `push' the new type, knowing it's in
-          ;; topological order by construction.
-          (setq cl--type-list
-                (merge-ordered-lists
-                 (cl--type-dag typelist)
-                 (lambda (_) (error "Invalid dependency graph")))))
+            (push name typelist)))
       (error
        (setf (symbol-plist name) oldplist)
        (error (format "Define %S failed: %s"
@@ -252,14 +229,8 @@ cl-types-of
        ;; Skip type, if it previously produced an error.
        (null (get type 'cl--type-error))
        ;; Skip type not defined by `cl-deftype'.
+       ;; FIXME: Can we make sure this is simply always true?
        (cl-type-class-p (cl--find-class type))
-       ;; If BAR is declared as a parent of FOO and `cl-types-of' has
-       ;; already decided that the value is of type FOO, then we
-       ;; already know BAR will be in the output anyway and there's no
-       ;; point testing BAR.  So, skip type already selected as parent
-       ;; of another type, assuming that, most of the time, `assq'
-       ;; will be faster than `cl-typep'.
-       (null (assq type found))
        ;; If OBJECT is of type, add type to the matching list.
        (condition-case-unless-debug e
            (cl-typep object type)
@@ -268,17 +239,10 @@ cl-types-of
     ;; Return an unique value of the list of types OBJECT belongs to,
     ;; which is also the list of specifiers for OBJECT.
     (with-memoization (gethash found cl--type-unique)
-      ;; Compute a DAG from the collected matching types.
-      (let (dag)
-        (dolist (type found)
-          (let ((pl (cl--type-parents type)))
-            (while pl
-              (push pl dag)
-              (setq pl (cdr pl)))))
-        ;; Compute an ordered list of types from the DAG.
-        (merge-ordered-lists
-         (nreverse (cons (cl--type-parents (cl-type-of object))
-                         dag)))))))
+      ;; Compute an ordered list of types from the DAG.
+      (merge-ordered-lists
+       (nreverse (mapcar #'cl--type-parents
+                         (cons (cl-type-of object) found)))))))
 
 ;;; Method dispatching
 ;;

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.