mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

comp: Propagate pre slot access type check

Browse source 
* lisp/loadup.el (max-lisp-eval-depth): Increase
`max-lisp-eval-depth' to 3400.

* lisp/emacs-lisp/comp.el (comp-add-cond-cstrs): Pattern match pre
slot access type check and add constraint.

* lisp/emacs-lisp/comp-cstr.el (comp-cstr-cl-tag-p)
(comp-cstr-cl-tag): New functions.

* lisp/emacs-lisp/comp.el (make-comp-mvar): Add neg parameter.
This commit is contained in:
Andrea Corallo 2023-05-17 18:00:24 +02:00
parent d03dd07774
commit 6c781b5d25
3 changed files with 34 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

17
lisp/emacs-lisp/comp-cstr.el
View file

@ -895,6 +895,23 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(null (neg cstr))
(equal (typeset cstr) '(cons)))))
;; Move to comp.el?
(defsubst comp-cstr-cl-tag-p (cstr)
"Return non-nil if CSTR is a CL tag."
(with-comp-cstr-accessors
(and (null (range cstr))
(null (neg cstr))
(null (typeset cstr))
(length= (valset cstr) 1)
(string-match (rx "cl-struct-" (group-n 1 (1+ not-newline)) "-tags")
(symbol-name (car (valset cstr)))))))
(defsubst comp-cstr-cl-tag (cstr)
"If CSTR is a CL tag return its tag name."
(with-comp-cstr-accessors
(and (comp-cstr-cl-tag-p cstr)
(intern (match-string 1 (symbol-name (car (valset cstr))))))))
(defun comp-cstr-= (dst op1 op2)
"Constraint OP1 being = OP2 setting the result into DST."
(with-comp-cstr-accessors