[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp c60f2f4: Fix `comp-cstr-intersection-no-hashcons' fo
From: |
Andrea Corallo |
Subject: |
feature/native-comp c60f2f4: Fix `comp-cstr-intersection-no-hashcons' for negated result cstr |
Date: |
Sat, 6 Mar 2021 17:17:35 -0500 (EST) |
branch: feature/native-comp
commit c60f2f458a63a8ae4288652228f24e43fdc7bba7
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Fix `comp-cstr-intersection-no-hashcons' for negated result cstr
* lisp/emacs-lisp/comp-cstr.el
(comp-cstr-intersection-no-hashcons): When negated and
necessary relax dst to t.
* test/src/comp-tests.el (comp-tests-type-spec-tests): Add a test.
---
lisp/emacs-lisp/comp-cstr.el | 32 +++++++++++++++++++-------------
test/src/comp-tests.el | 9 ++++++++-
2 files changed, 27 insertions(+), 14 deletions(-)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index d6423ef..4397a91 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -1001,20 +1001,26 @@ promoted to their types.
DST is returned."
(with-comp-cstr-accessors
(apply #'comp-cstr-intersection dst srcs)
- (let (strip-values strip-types)
- (cl-loop for v in (valset dst)
- unless (or (symbolp v)
- (fixnump v))
- do (push v strip-values)
- (push (type-of v) strip-types))
- (when strip-values
- (setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
- (valset dst) (cl-set-difference (valset dst) strip-values)))
- (cl-loop for (l . h) in (range dst)
- when (or (bignump l) (bignump h))
+ (if (and (neg dst)
+ (valset dst)
+ (cl-notevery #'symbolp (valset dst)))
+ (setf (valset dst) ()
+ (typeset dst) '(t)
+ (range dst) ()
+ (neg dst) nil)
+ (let (strip-values strip-types)
+ (cl-loop for v in (valset dst)
+ unless (symbolp v)
+ do (push v strip-values)
+ (push (type-of v) strip-types))
+ (when strip-values
+ (setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
+ (valset dst) (cl-set-difference (valset dst) strip-values)))
+ (cl-loop for (l . h) in (range dst)
+ when (or (bignump l) (bignump h))
do (setf (range dst) '((- . +)))
- (cl-return))
- dst)))
+ (cl-return))))
+ dst))
(defun comp-cstr-intersection-make (&rest srcs)
"Combine SRCS by intersection set operation and return a new constraint."
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index cd1c2e0..f60e4ab 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -1340,7 +1340,14 @@ Return a list of results."
(unless (eql x -0.0)
(error ""))
x)
- float)))
+ float)
+
+ ;; 73
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (eql x 1.0)
+ (error ""))
+ x)
+ t)))
(defun comp-tests-define-type-spec-test (number x)
`(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- feature/native-comp c60f2f4: Fix `comp-cstr-intersection-no-hashcons' for negated result cstr,
Andrea Corallo <=