feature/native-comp 73b5e40 3/6: * Code rework add `comp-cstrs-homogeneous'

[Andrea Corallo]

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

    * Code rework add `comp-cstrs-homogeneous'
    
        * lisp/emacs-lisp/comp-cstr.el (comp-cstrs-homogeneous): New
        function.
        (comp-cstr-union-1-no-mem): Make use of.
---
 lisp/emacs-lisp/comp-cstr.el | 31 +++++++++++++++++++------------
 1 file changed, 19 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 892a8d3..9182fc3 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -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