Cleanup some type predicates

Use the new `cl--define-built-in-type` to reduce the manually
maintained list of built-in type predicates.
Also tweak docstrings to use "supertype" rather than "super type",
since it seems to be what we use elsewhere.

* lisp/subr.el (special-form-p): Remove redundant `fboundp` test.
(compiled-function-p): Don'Return nil for subrs that aren't functions.

* lisp/emacs-lisp/cl-macs.el (type predicates): Trim down the list.

* lisp/emacs-lisp/cl-preloaded.el (cl--define-built-in-type):
Register the corresponding predicate if applicable.
(atom, null): Specify the predicate name explicitly.

lisp/emacs-lisp/cl-macs.el

@@ -3463,45 +3463,12 @@ Of course, we really can't know that for sure, so it's just a heuristic."
 ;; Please keep it in sync with `comp-known-predicates'.
 (pcase-dolist (`(,type . ,pred)
                ;; Mostly kept in alphabetical order.
-               '((array		. arrayp)
+               ;; These aren't defined via `cl--define-built-in-type'.
-                 (atom		. atom)
+               '((base-char	. characterp) ;Could be subtype of `fixnum'.
-                 (base-char	. characterp)
+                 (character	. natnump)    ;Could be subtype of `fixnum'.
-                 (bignum	. bignump)
+                 (command	. commandp)   ;Subtype of closure & subr.
-                 (boolean	. booleanp)
+                 (natnum	. natnump)    ;Subtype of fixnum & bignum.
-                 (bool-vector	. bool-vector-p)
+                 (real		. numberp)    ;Not clear where it would fit.
-                 (buffer	. bufferp)
-                 (byte-code-function . byte-code-function-p)
-                 (character	. natnump)
-                 (char-table	. char-table-p)
-                 (command	. commandp)
-                 (compiled-function . compiled-function-p)
-                 (hash-table	. hash-table-p)
-                 (cons		. consp)
-                 (fixnum	. fixnump)
-                 (float		. floatp)
-                 (frame		. framep)
-                 (function	. functionp)
-                 (integer	. integerp)
-                 (keyword	. keywordp)
-                 (list		. listp)
-                 (marker	. markerp)
-                 (natnum	. natnump)
-                 (number	. numberp)
-                 (null		. null)
-                 (obarray	. obarrayp)
-                 (overlay	. overlayp)
-                 (process	. processp)
-                 (real		. numberp)
-                 (sequence	. sequencep)
-                 (subr		. subrp)
-                 (string	. stringp)
-                 (symbol	. symbolp)
-                 (symbol-with-pos . symbol-with-pos-p)
-                 (vector	. vectorp)
-                 (window	. windowp)
-                 ;; FIXME: Do we really want to consider these types?
-                 (number-or-marker . number-or-marker-p)
-                 (integer-or-marker . integer-or-marker-p)
                  ))
   (put type 'cl-deftype-satisfies pred))
 

lisp/emacs-lisp/cl-preloaded.el

@@ -308,7 +308,7 @@
                (:copier nil))
   )
 
-(defmacro cl--define-built-in-type (name parents &optional docstring &rest _slots)
+(defmacro cl--define-built-in-type (name parents &optional docstring &rest slots)
   ;; `slots' is currently unused, but we could make it take
   ;; a list of "slot like properties" together with the corresponding
   ;; accessor, and then we could maybe even make `slot-value' work
@@ -317,7 +317,18 @@
   (unless (listp parents) (setq parents (list parents)))
   (unless (or parents (eq name t))
     (error "Missing parents for %S: %S" name parents))
+  (let ((predicate (intern-soft (format
+                                 (if (string-match "-" (symbol-name name))
+                                     "%s-p" "%sp")
+                                 name))))
+    (unless (fboundp predicate) (setq predicate nil))
+    (while (keywordp (car slots))
+      (let ((kw (pop slots)) (val (pop slots)))
+        (pcase kw
+          (:predicate (setq predicate val))
+          (_ (error "Unknown keyword arg: %S" kw)))))
     `(progn
+       ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate))
        (put ',name 'cl--class
             (built-in-class--make ',name ,docstring
                                   (mapcar (lambda (type)
@@ -325,7 +336,7 @@
                                               (unless class
                                                 (error "Unknown type: %S" type))
                                               class))
-                                        ',parents)))))
+                                          ',parents))))))
 
 ;; FIXME: Our type DAG has various quirks:
 ;; - `subr' says it's a `compiled-function' but that's not true
@@ -336,8 +347,9 @@
 ;;   so the DAG of OClosure types is "orthogonal" to the distinction
 ;;   between interpreted and compiled functions.
 
-(cl--define-built-in-type t nil "The type of everything.")
+(cl--define-built-in-type t nil "Abstract supertype of everything.")
-(cl--define-built-in-type atom t "The type of anything but cons cells.")
+(cl--define-built-in-type atom t "Abstract supertype of anything but cons cells."
+                          :predicate atom)
 
 (cl--define-built-in-type tree-sitter-compiled-query atom)
 (cl--define-built-in-type tree-sitter-node atom)
@@ -404,7 +416,8 @@ For this build of Emacs it's %dbit."
   "Type of special arrays that are indexed by characters.")
 (cl--define-built-in-type string (array))
 (cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before `list'?
-  "Type of the nil value.")
+  "Type of the nil value."
+  :predicate null)
 (cl--define-built-in-type cons (list)
   "Type of cons cells."
   ;; Example of slots we could document.

lisp/emacs-lisp/oclosure.el

@@ -437,7 +437,7 @@ This has 2 uses:
 - For compiled code, this is used as a marker which cconv uses to check that
   immutable fields are indeed not mutated."
   (if (byte-code-function-p oclosure)
-      ;; Actually, this should never happen since the `cconv.el' should have
+      ;; Actually, this should never happen since `cconv.el' should have
       ;; optimized away the call to this function.
       oclosure
     ;; For byte-coded functions, we store the type as a symbol in the docstring

lisp/subr.el

@@ -4494,8 +4494,7 @@ Otherwise, return nil."
 (defun special-form-p (object)
   "Non-nil if and only if OBJECT is a special form."
   (declare (side-effect-free error-free))
-  (if (and (symbolp object) (fboundp object))
+  (if (symbolp object) (setq object (indirect-function object)))
-      (setq object (indirect-function object)))
   (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
 
 (defun plistp (object)
@@ -4517,7 +4516,8 @@ Otherwise, return nil."
 Does not distinguish between functions implemented in machine code
 or byte-code."
   (declare (side-effect-free error-free))
-  (or (subrp object) (byte-code-function-p object)))
+  (or (and (subrp object) (not (eq 'unevalled (cdr (subr-arity object)))))
+      (byte-code-function-p object)))
 
 (defun field-at-pos (pos)
   "Return the field at position POS, taking stickiness etc into account."