feature/native-comp 43d0e84 2/2: Fix `functionp' contraining (bug#45576)

[Andrea Corallo]

branch: feature/native-comp
commit 43d0e8483e5b51aec1347b8a2ed53acae34a9811
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    Fix `functionp' contraining (bug#45576)
    
        * lisp/emacs-lisp/comp.el (comp-known-predicates)
        (comp-known-predicates-h): New constants.
        (comp-known-predicate-p, comp-pred-to-cstr): New functions.
        * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Don't define.
        * test/src/comp-tests.el (comp-test-45576): New testcase.
        * test/src/comp-test-funcs.el (comp-test-45576-f): New function.
---
 lisp/emacs-lisp/cl-macs.el   |  3 +--
 lisp/emacs-lisp/comp-cstr.el |  6 +-----
 lisp/emacs-lisp/comp.el      | 49 ++++++++++++++++++++++++++++++++++++++++----
 test/src/comp-test-funcs.el  |  8 ++++++++
 test/src/comp-tests.el       |  5 +++++
 5 files changed, 60 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 664d865..ac7360b 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3199,8 +3199,7 @@ Of course, we really can't know that for sure, so it's 
just a heuristic."
                  ;; FIXME: Do we really want to consider this a type?
                  (integer-or-marker . integer-or-marker-p)
                  ))
-  (put type 'cl-deftype-satisfies pred)
-  (put pred 'cl-satisfies-deftype type))
+  (put type 'cl-deftype-satisfies pred))
 
 ;;;###autoload
 (define-inline cl-typep (val type)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index a53372b..e63afa1 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -2,7 +2,7 @@
 
 ;; Author: Andrea Corallo <akrl@sdf.com>
 
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
 
 ;; Keywords: lisp
 ;; Package: emacs
@@ -179,10 +179,6 @@ Return them as multiple value."
 (defvar comp-cstr-one (comp-value-to-cstr 1)
   "Represent the integer immediate one.")
 
-(defun comp-pred-to-cstr (predicate)
-  "Given PREDICATE return the correspondig constraint."
-  (comp-type-to-cstr (get predicate 'cl-satisfies-deftype)))
-
 
 ;;; Value handling.
 
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index ab3763f..455fd72 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -500,6 +500,51 @@ Useful to hook into pass checkers.")
    finally return h)
   "Hash table function -> `comp-constraint'")
 
+(defconst comp-known-predicates
+  '((arrayp              . array)
+    (atom               . atom)
+    (characterp          . base-char)
+    (booleanp            . boolean)
+    (bool-vector-p       . bool-vector)
+    (bufferp             . buffer)
+    (natnump             . character)
+    (char-table-p       . char-table)
+    (hash-table-p       . hash-table)
+    (consp               . cons)
+    (integerp            . fixnum)
+    (floatp              . float)
+    (functionp           . (or function symbol))
+    (integerp            . integer)
+    (keywordp            . keyword)
+    (listp               . list)
+    (numberp             . number)
+    (null               . null)
+    (numberp             . real)
+    (sequencep           . sequence)
+    (stringp             . string)
+    (symbolp             . symbol)
+    (vectorp             . vector)
+    (integer-or-marker-p . integer-or-marker))
+  "Alist predicate -> matched type specifier.")
+
+(defconst comp-known-predicates-h
+  (cl-loop
+   with comp-ctxt = (make-comp-cstr-ctxt)
+   with h = (make-hash-table :test #'eq)
+   for (pred . type-spec) in comp-known-predicates
+   for cstr = (comp-type-spec-to-cstr type-spec)
+   do (puthash pred cstr h)
+   finally return h)
+  "Hash table function -> `comp-constraint'")
+
+(defun comp-known-predicate-p (predicate)
+  "Predicate matching if PREDICATE is known."
+  (when (gethash predicate comp-known-predicates-h) t))
+
+(defun comp-pred-to-cstr (predicate)
+  "Given PREDICATE return the correspondig constraint."
+  (gethash predicate comp-known-predicates-h))
+
 (defconst comp-symbol-values-optimizable '(most-positive-fixnum
                                            most-negative-fixnum)
   "Symbol values we can resolve in the compile-time.")
@@ -2329,10 +2374,6 @@ TARGET-BB-SYM is the symbol name of the target block."
           (comp-emit-assume 'and obj1 obj2 block-target negated))
         finally (cl-return-from in-the-basic-block)))))))
 
-(defun comp-known-predicate-p (pred)
-  (when (symbolp pred)
-    (get pred 'cl-satisfies-deftype)))
-
 (defun comp-add-cond-cstrs ()
   "`comp-add-cstrs' worker function for each selected function."
   (cl-loop
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index 1c2fb3d..d0ec636 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -455,6 +455,14 @@
       (print x)
     (car x)))
 
+(defun comp-test-45576-f ()
+  ;; Reduced from `eshell-find-alias-function'.
+  (let ((sym (intern-soft "eval")))
+    (if (and (functionp sym)
+            '(eshell-ls eshell-pred eshell-prompt eshell-script
+                        eshell-term eshell-unix))
+       sym)))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 9801136..faaa2f4 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -482,6 +482,11 @@ 
https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html.";
 (comp-deftest comp-test-not-cons ()
   (should-not (comp-test-not-cons-f nil)))
 
+(comp-deftest comp-test-45576 ()
+  "Functionp satisfies also symbols.
+<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-01/msg00029.html>."
+  (should (eq (comp-test-45576-f) 'eval)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;