scratch/comp-all-types 51f8cc75a82 3/5: comp: Make use of predicates in propagation for non builtin types

[Andrea Corallo]

branch: scratch/comp-all-types
commit 51f8cc75a82cafeb5f24ad90e092b8d978588d79
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    comp: Make use of predicates in propagation for non builtin types
    
    * lisp/emacs-lisp/comp-cstr.el (comp-cstr-ctxt): Add `pred-type-h'
    slot.
    * lisp/emacs-lisp/comp.el (comp-known-predicate-p)
    (comp-pred-to-cstr): Update.
---
 lisp/emacs-lisp/comp-cstr.el | 8 ++++++++
 lisp/emacs-lisp/comp.el      | 7 +++++--
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 869b0619160..35e9ac45919 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -107,6 +107,14 @@ Integer values are handled in the `range' slot.")
                         (mapcar #'comp--cl-class-hierarchy 
(comp--all-classes)))
                 :type list
                 :documentation "Type hierarchy.")
+  (pred-type-h (cl-loop with h = (make-hash-table :test #'eq)
+                       for class-name in (comp--all-classes)
+                        for pred = (get class-name 'cl-deftype-satisfies)
+                        when pred
+                          do (puthash pred class-name h)
+                       finally return h)
+               :type hash-table
+               :documentation "Hash pred -> type.")
   (union-typesets-mem (make-hash-table :test #'equal) :type hash-table
                       :documentation "Serve memoization for
 `comp-union-typesets'.")
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 289c5bf2ac4..fe72f0e73a4 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -641,11 +641,14 @@ Useful to hook into pass checkers.")
 
 (defun comp-known-predicate-p (predicate)
   "Return t if PREDICATE is known."
-  (when (gethash predicate comp-known-predicates-h) t))
+  (when (or (gethash predicate comp-known-predicates-h)
+            (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))
+    t))
 
 (defun comp-pred-to-cstr (predicate)
   "Given PREDICATE, return the corresponding constraint."
-  (gethash predicate comp-known-predicates-h))
+  (or (gethash predicate comp-known-predicates-h)
+      (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))))
 
 (defconst comp-symbol-values-optimizable '(most-positive-fixnum
                                            most-negative-fixnum)