feature/native-comp 0a89ed7 4/5: * Fix non range cstr union operation

[Andrea Corallo]

branch: feature/native-comp
commit 0a89ed7a962e22892e9c700cfca188197af2a6ad
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    * Fix non range cstr union operation
    
        * 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.
---
 lisp/emacs-lisp/comp-cstr.el | 18 ++++++++++--------
 1 file changed, 10 insertions(+), 8 deletions(-)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 480d156..92c981f 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))