procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix eql' equal' propagation of non hash consed values (bug#46843)

Browse source 
Extend assumes allowing the following form:

(assume dst (and-nhc src1 src2))

`and-nhc' assume operator allow for constraining correctly
intersections where non hash consed values are not propagated as
values but rather promoted to their types.

	* lisp/emacs-lisp/comp-cstr.el
	(comp-cstr-intersection-no-hashcons): New function.
	* lisp/emacs-lisp/comp.el (comp-emit-assume): Logic update to emit
	`and-nhc' operator (implemented in fwprop by
	`comp-cstr-intersection-no-hashcons').
	(comp-add-cond-cstrs): Map `eq' to `and' assume operator and
	`equal' `eql' into `and-nhc'.
	(comp-fwprop-insn): Update to handle `and-nhc'.
	* test/src/comp-tests.el (comp-tests-type-spec-tests): Add two
	tests covering `eql' and `equal' propagation of non hash consed
	values.
This commit is contained in:
Andrea Corallo 2021-03-01 19:39:00 +01:00
parent 5bc08559e8
commit 3d014e1bf4
3 changed files with 47 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -968,6 +968,28 @@ DST is returned."
(neg dst) (neg res))
res)))
(defun comp-cstr-intersection-no-hashcons (dst &rest srcs)
"Combine SRCS by intersection set operation setting the result in DST.
Non hash consed values are not propagated as values but rather
promoted to their types.
DST is returned."
(with-comp-cstr-accessors
(apply #'comp-cstr-intersection dst srcs)
(let (strip-values strip-types)
(cl-loop for v in (valset dst)
unless (or (symbolp v)
(fixnump v))
do (push v strip-values)
(push (type-of v) strip-types))
(when strip-values
(setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
(valset dst) (cl-set-difference (valset dst) strip-values)))
(cl-loop for (l . h) in (range dst)
when (or (bignump l) (bignump h))
do (setf (range dst) '((- . +)))
(cl-return))
dst)))
(defun comp-cstr-intersection-make (&rest srcs)
"Combine SRCS by intersection set operation and return a new constraint."
(apply #'comp-cstr-intersection (make-comp-cstr) srcs))