From: Andrea Corallo <akrl@sdf.org>
Date: Wed, 24 Aug 2022 21:31:28 +0000 (+0200)
Subject: comp: Make use of predicates in propagation for non builtin types
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d03dd07774acfa690e5b63a7dbf81fb319aeedf4;p=emacs.git

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.
---

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)