mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-22 21:50:45 -08:00
Code Issues Projects Releases Wiki Activity

* Fix non range cstr union operation

Browse source 
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-union-homogeneous): Add
	range parameter and handle the non range case.
	(comp-cstr-union-1-no-mem, comp-cstr-intersection-no-mem): Update
	`comp-cstr-union-homogeneous' call sites.
This commit is contained in:
Andrea Corallo 2020-12-23 14:03:54 +01:00
parent c90aa68d90
commit 0a89ed7a96
1 changed files with 10 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -383,8 +383,9 @@ All SRCS constraints must be homogeneously negated or non-negated."
dst)
(defun comp-cstr-union-homogeneous (dst &rest srcs)
(defun comp-cstr-union-homogeneous (range dst &rest srcs)
"Combine SRCS by union set operation setting the result in DST.
Do range propagation when RANGE is non-nil.
All SRCS constraints must be homogeneously negated or non-negated.
DST is returned."
(apply #'comp-cstr-union-homogeneous-no-range dst srcs)
@ -397,9 +398,10 @@ DST is returned."
(when (cl-notany (lambda (x)
(comp-subtype-p 'integer x))
(comp-cstr-typeset dst))
;; TODO memoize?
(apply #'comp-range-union
(mapcar #'comp-cstr-range srcs))))
(if range
(apply #'comp-range-union
(mapcar #'comp-cstr-range srcs))
'((- . +)))))
dst)
(cl-defun comp-cstr-union-1-no-mem (range &rest srcs)
@ -419,17 +421,17 @@ DST is returned."
;; Check first if we are in the simple case of all input non-negate
;; or negated so we don't have to cons.
(when-let ((res (comp-cstrs-homogeneous srcs)))
(apply #'comp-cstr-union-homogeneous dst srcs)
(apply #'comp-cstr-union-homogeneous range dst srcs)
(cl-return-from comp-cstr-union-1-no-mem dst))
;; Some are negated and some are not
(cl-multiple-value-bind (positives negatives) (comp-split-pos-neg srcs)
(let* ((pos (apply #'comp-cstr-union-homogeneous
(let* ((pos (apply #'comp-cstr-union-homogeneous range
(make-comp-cstr) positives))
;; We'll always use neg as result as this is almost
;; always necessary for describing open intervals
;; resulting from negated constraints.
(neg (apply #'comp-cstr-union-homogeneous
(neg (apply #'comp-cstr-union-homogeneous range
(make-comp-cstr :neg t) negatives)))
;; Type propagation.
(when (and (typeset pos)
@ -586,7 +588,7 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(cl-return-from comp-cstr-intersection-no-mem dst)))
(when-let ((res (comp-cstrs-homogeneous srcs)))
(if (eq res 'neg)
(apply #'comp-cstr-union-homogeneous dst srcs)
(apply #'comp-cstr-union-homogeneous t dst srcs)
(apply #'comp-cstr-intersection-homogeneous dst srcs))
(cl-return-from comp-cstr-intersection-no-mem dst))