[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp ac40a60 1/3: Couple of `comp-cstr-union-1-no-mem' im
From: |
Andrea Corallo |
Subject: |
feature/native-comp ac40a60 1/3: Couple of `comp-cstr-union-1-no-mem' improvements for mixed neg pos union |
Date: |
Sun, 6 Dec 2020 12:36:22 -0500 (EST) |
branch: feature/native-comp
commit ac40a60696322cd92f37fcddda97ae9c00226bf8
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
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.
---
lisp/emacs-lisp/comp-cstr.el | 32 +++++++++++++++++++++++---------
test/lisp/emacs-lisp/comp-cstr-tests.el | 7 +++++--
2 files changed, 28 insertions(+), 11 deletions(-)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index bb63ff3..d4e47cf 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 bc772fc..6e1d0d4 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 ()