diff options
| author | Andrea Corallo <akrl@sdf.org> | 2021-03-06 22:36:50 +0100 |
|---|---|---|
| committer | Andrea Corallo <akrl@sdf.org> | 2021-03-06 23:17:14 +0100 |
| commit | c60f2f458a63a8ae4288652228f24e43fdc7bba7 (patch) | |
| tree | bdd1f91cbff403ac013e2eeb02dd837d1b3a14a6 /lisp/emacs-lisp/comp-cstr.el | |
| parent | 6c73418c95ae5aca7e63d8d5703a90e178350527 (diff) | |
| download | emacs-c60f2f458a63a8ae4288652228f24e43fdc7bba7.tar.gz emacs-c60f2f458a63a8ae4288652228f24e43fdc7bba7.tar.bz2 emacs-c60f2f458a63a8ae4288652228f24e43fdc7bba7.zip | |
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.
Diffstat (limited to 'lisp/emacs-lisp/comp-cstr.el')
| -rw-r--r-- | lisp/emacs-lisp/comp-cstr.el | 32 |
1 files changed, 19 insertions, 13 deletions
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index d6423efa0d6..4397a914981 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." |