diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -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." |