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.
This commit is contained in:
parent
03be03d366
commit
43d0e8483e
5 changed files with 60 additions and 11 deletions
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;;
|
||||
|
|
|
@ -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. ;;
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue