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

Couple of `comp-cstr-union-1-no-mem' improvements for mixed neg pos union

Browse source 
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-union-1-no-mem):
	Generalize disjoint pos types vs neg values conditions.
	(comp-cstr-union-1-no-mem): Do not propagate ranges when we are
	already returning integer as generic type.
	* test/lisp/emacs-lisp/comp-cstr-tests.el
	(comp-cstr-typespec-tests-alist): Add corresponding tests.
This commit is contained in:
Andrea Corallo 2020-12-05 23:42:25 +01:00
parent 09ec39e352
commit ac40a60696
2 changed files with 28 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -383,6 +383,23 @@ DST is returned."
(neg dst) nil)
(cl-return-from comp-cstr-union-1-no-mem dst))
;; Verify disjoint condition between positive types and
;; negative types coming from values, in case give-up.
(let ((neg-value-types (nconc (mapcar #'type-of (valset neg))
(when (range neg)
'(integer)))))
(when (cl-some (lambda (x)
(cl-some (lambda (y)
(and (not (eq y x))
(comp-subtype-p y x)))
neg-value-types))
(typeset pos))
(setf (typeset dst) '(t)
(valset dst) ()
(range dst) ()
(neg dst) nil)
(cl-return-from comp-cstr-union-1-no-mem dst)))
;; Value propagation.
(cond
((and (valset pos) (valset neg)
@ -401,12 +418,8 @@ DST is returned."
;; Range propagation
(if (and range
(or (range pos)
(range neg))
(cl-notany (lambda (x)
(comp-subtype-p 'integer x))
(typeset pos)))
(if (or (valset neg)
(typeset neg))
(range neg)))
(if (or (valset neg) (typeset neg))
(setf (range neg)
(if (memq 'integer (typeset neg))
(comp-range-negation (range pos))
@ -416,9 +429,10 @@ DST is returned."
;; When possibile do not return a negated cstr.
(setf (typeset dst) (typeset pos)
(valset dst) (valset pos)
(range dst) (comp-range-union
(comp-range-negation (range neg))
(range pos))
(range dst) (unless (memq 'integer (typeset dst))
(comp-range-union
(comp-range-negation (range neg))
(range pos)))
(neg dst) nil)
(cl-return-from comp-cstr-union-1-no-mem dst))
(setf (range neg) ()))