From: Andrea Corallo <akrl@sdf.org>
Date: Sat, 5 Dec 2020 22:42:25 +0000 (+0100)
Subject: Couple of `comp-cstr-union-1-no-mem' improvements for mixed neg pos union
X-Git-Tag: emacs-28.0.90~2727^2~281
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ac40a60696322cd92f37fcddda97ae9c00226bf8;p=emacs.git

Couple of `comp-cstr-union-1-no-mem' improvements for mixed neg pos union

	* lisp/emacs-lisp/comp-cstr.el (comp-cstr-union-1-no-mem):
	Generalize disjoint pos types vs neg values conditions.
	(comp-cstr-union-1-no-mem): Do not propagate ranges when we are
	already returning integer as generic type.
	* test/lisp/emacs-lisp/comp-cstr-tests.el
	(comp-cstr-typespec-tests-alist): Add corresponding tests.
---

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index bb63ff3e961..d4e47cf302f 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -383,6 +383,23 @@ DST is returned."
                (neg dst) nil)
          (cl-return-from comp-cstr-union-1-no-mem dst))
 
+       ;; Verify disjoint condition between positive types and
+       ;; negative types coming from values, in case give-up.
+       (let ((neg-value-types (nconc (mapcar #'type-of (valset neg))
+                                           (when (range neg)
+                                             '(integer)))))
+         (when (cl-some (lambda (x)
+                          (cl-some (lambda (y)
+                                     (and (not (eq y x))
+                                          (comp-subtype-p y x)))
+                                   neg-value-types))
+                        (typeset pos))
+           (setf (typeset dst) '(t)
+                 (valset dst) ()
+                 (range dst) ()
+                 (neg dst) nil)
+           (cl-return-from comp-cstr-union-1-no-mem dst)))
+
        ;; Value propagation.
        (cond
         ((and (valset pos) (valset neg)
@@ -401,12 +418,8 @@ DST is returned."
        ;; Range propagation
        (if (and range
                 (or (range pos)
-                    (range neg))
-                (cl-notany (lambda (x)
-                             (comp-subtype-p 'integer x))
-                           (typeset pos)))
-           (if (or (valset neg)
-                   (typeset neg))
+                    (range neg)))
+           (if (or (valset neg) (typeset neg))
                (setf (range neg)
                      (if (memq 'integer (typeset neg))
                          (comp-range-negation (range pos))
@@ -416,9 +429,10 @@ DST is returned."
              ;; When possibile do not return a negated cstr.
              (setf (typeset dst) (typeset pos)
                    (valset dst) (valset pos)
-                   (range dst) (comp-range-union
-                                (comp-range-negation (range neg))
-                                (range pos))
+                   (range dst) (unless (memq 'integer (typeset dst))
+                                 (comp-range-union
+                                  (comp-range-negation (range neg))
+                                  (range pos)))
                    (neg dst) nil)
              (cl-return-from comp-cstr-union-1-no-mem dst))
          (setf (range neg) ()))
diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el
index bc772fcb0d2..6e1d0d463e1 100644
--- a/test/lisp/emacs-lisp/comp-cstr-tests.el
+++ b/test/lisp/emacs-lisp/comp-cstr-tests.el
@@ -81,7 +81,7 @@
     ((not symbol) . (not symbol))
     ((or (member foo) (not (member foo bar))) . (not (member bar)))
     ((or (member foo bar) (not (member foo))) . t)
-    ;; Intentionally conservative, see `comp-cstr-union'.
+    ;; Intentionally conservative, see `comp-cstr-union-1-no-mem'.
     ((or symbol (not sequence)) . t)
     ((or symbol (not symbol)) . t)
     ;; Conservative.
@@ -98,7 +98,10 @@
     ((or (member foo) (not string)) . (not string))
     ((or (not (integer 1 2)) integer) . integer)
     ((or (not (integer 1 2)) (not integer)) . (not integer))
-    ((or (integer 1 2) (not integer)) . (not (or integer (integer * 0) (integer 3 *)))))
+    ((or (integer 1 2) (not integer)) . (not (or integer (integer * 0) (integer 3 *))))
+    ((or number (not (integer 1 2))) . t)
+    ((or atom (not (integer 1 2))) . t)
+    ((or atom (not (member foo))) . t))
   "Alist type specifier -> expected type specifier.")
 
 (defmacro comp-cstr-synthesize-tests ()