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
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue