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.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 664d865cffdc9638433654aea1098250a7d5ab20..ac7360b935b274fb9c4dbd53a017419fd48e7e55 100644 (file)
--- 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 a53372be0060af20963e257feca311f608eaba1e..e63afa16a2324ef95af4d453c069a398b43645ba 100644 (file)
--- 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)))
-
 \f
 ;;; Value handling.
 

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index ab3763f5edffff63c859e57d357d01e199e109cf..455fd72efcd560895da629a3621791a774bf4c31 100644 (file)
--- 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 1c2fb3d3c0be7c5980e3086967766b6473b7c830..d0ec63658191b1a347988e0eb9266fa3e1263e87 100644 (file)
--- 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)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 9801136152a948f1944c7ff48805b0035891bb41..faaa2f4e4f819b3ba480f1f850dede07b1e5c92b 100644 (file)
--- 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)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;