cl-preloaded.el: Fix the type lattice

We generally want types to form not just a DAG but a lattice.
If objects can be both `keyword` and `symbol-with-pos`, this
means there should be a more precise type describing this intersection.
If we ever find the need for such a refinement, we could add
such a `keyword-with-pos` type, but here I took the simpler
route of treating `keyword` not as a proper built-in type but
as a second-class type like `natnum`.

While fixing this problem, also fix the problem we had where
`functionp` was not quite adequate to characterize objects of type
`function`, by introducing a new predicate `cl-functionp` for that.

* lisp/emacs-lisp/cl-preloaded.el (cl-functionp): New function.
(function): Use it.
(keyword): Don't declare it as a built-in type.
(user-ptrp): Remove redundant declaration.

* lisp/emacs-lisp/cl-generic.el (cl--generic--unreachable-types):
Delete constant.
(cl-generic-generalizers): Remove corresponding test.

* lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add entry for
`keyword` type.

* lisp/emacs-lisp/comp.el (comp-known-predicates): Fix type for
negative result of `characterp`.  Remove duplicate `numberp` entry.
Fix types for `keywordp` now that `keyword` is not a built-in type any more.

* test/src/data-tests.el (data-tests--cl-type-of): Add a few cases.
Remove workaround for `function`.

1 files changed, 15 insertions, 15 deletions

diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index daa49e671b5..753d74c02ec 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -845,10 +845,12 @@ comparing the subr with a much slower Lisp implementation."
   ;; Note: This doesn't work for list/vector structs since those types
   ;; are too difficult/unreliable to detect (so `cl-type-of' only says
   ;; it's a `cons' or a `vector').
-  (dolist (val (list -2 10 (expt 2 128) nil t 'car
+  (dolist (val (list -2 10 (expt 2 128) nil t 'car :car
                      (symbol-function 'car)
                      (symbol-function 'progn)
-                     (position-symbol 'car 7)))
+                     (eval '(lambda (x) (+ x 1)) t)
+                     (position-symbol 'car 7)
+                     (position-symbol :car 7)))
     (let* ((type (cl-type-of val))
            (class (cl-find-class type))
            (alltypes (cl--class-allparents class))
@@ -858,19 +860,17 @@ comparing the subr with a much slower Lisp implementation."
       (dolist (parent alltypes)
         (should (cl-typep val parent))
         (dolist (subtype (cl--class-children (cl-find-class parent)))
-          (unless (memq subtype alltypes)
-            (unless (memq subtype
-                          ;; FIXME: Some types don't have any associated
-                          ;; predicate,
-                          '( font-spec font-entity font-object
-                             finalizer condvar terminal
-                             native-comp-unit interpreted-function
-                             tree-sitter-compiled-query
-                             tree-sitter-node tree-sitter-parser
-                             ;; `functionp' also matches things of type
-                             ;; `symbol' and `cons'.
-                             function))
-              (should-not (cl-typep val subtype)))))))))
+          (when (and (not (memq subtype alltypes))
+                     (built-in-class-p (cl-find-class subtype))
+                     (not (memq subtype
+                                ;; FIXME: Some types don't have any associated
+                                ;; predicate,
+                                '( font-spec font-entity font-object
+                                   finalizer condvar terminal
+                                   native-comp-unit interpreted-function
+                                   tree-sitter-compiled-query
+                                   tree-sitter-node tree-sitter-parser))))
+            (should-not (cl-typep val subtype))))))))
 
 
 ;;; data-tests.el ends here