diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/comp-cstr.el | 18 |
1 files changed, 10 insertions, 8 deletions
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 480d15616a0..92c981f5acf 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -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)) |