diff options
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/comp-cstr.el | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 49 | ||||
| -rw-r--r-- | test/src/comp-test-funcs.el | 8 | ||||
| -rw-r--r-- | 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 664d865cffd..ac7360b935b 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 a53372be006..e63afa16a23 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 ab3763f5edf..455fd72efcd 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 1c2fb3d3c0b..d0ec6365819 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 9801136152a..faaa2f4e4f8 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. ;; |