mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* Code rework add `comp-cstrs-homogeneous'

Browse source 
* lisp/emacs-lisp/comp-cstr.el (comp-cstrs-homogeneous): New
	function.
	(comp-cstr-union-1-no-mem): Make use of.
This commit is contained in:
Andrea Corallo 2020-12-07 21:33:11 +01:00
parent c39fad909c
commit 73b5e40750
1 changed files with 19 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -115,6 +115,21 @@ Integer values are handled in the `range' slot.")
:range (copy-tree (range cstr))
:neg (copy-tree (neg cstr)))))
(defun comp-cstrs-homogeneous (cstrs)
"Check if constraints CSTRS are all homogeneously negated or non-negated.
Return `pos' if they are all positive, `neg' if they are all
negated or nil othewise."
(cl-loop
for cstr in cstrs
unless (comp-cstr-neg cstr)
count t into n-pos
else
count t into n-neg
finally
(cond
((zerop n-neg) (cl-return 'pos))
((zerop n-pos) (cl-return 'neg)))))
;;; Type handling.
@ -342,18 +357,10 @@ 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.
(cl-loop
for cstr in srcs
unless (neg cstr)
count t into n-pos
else
count t into n-neg
finally
(when (or (zerop n-pos) (zerop n-neg))
(apply #'comp-cstr-union-homogeneous dst srcs)
(when (zerop n-pos)
(setf (neg dst) t))
(cl-return-from comp-cstr-union-1-no-mem dst)))
(when-let ((res (comp-cstrs-homogeneous srcs)))
(apply #'comp-cstr-union-homogeneous dst srcs)
(setf (neg dst) (eq res 'neg))
(cl-return-from comp-cstr-union-1-no-mem dst))
;; Some are negated and some are not
(cl-loop