From d03dd07774acfa690e5b63a7dbf81fb319aeedf4 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Wed, 24 Aug 2022 23:31:28 +0200
Subject: [PATCH] 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)
-- 
2.39.2