Enable integer range narrowing under compare and branch

	* lisp/emacs-lisp/comp-cstr.el (comp-cstr-set-cmp-range)
	(comp-cstr->, comp-cstr->=, comp-cstr-<, comp-cstr-<=): New
	functions.
	* lisp/emacs-lisp/comp.el (comp-equality-fun-p)
	(comp-range-cmp-fun-p): New functions.
	(comp-collect-rhs): Use `comp-assign-op-p' in place of
	`comp-set-op-p'.
	(comp-negate-range-cmp-fun, comp-reverse-cmp-fun): New functions.
	(comp-emit-assume): Rework to be able to emit also comparision
	assumption.
	(comp-add-cond-cstrs-simple): Update for new `comp-emit-assume'.
	(comp-add-cond-cstrs-simple): Update to emit range assumption.
	(comp-fwprop-insn): Execute range assumptions.
	* test/src/comp-tests.el (comp-tests-type-spec-tests): Add tests.

1 files changed, 68 insertions, 0 deletions

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 32989f220a4..9d0c67177b2 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -362,6 +362,22 @@ Return them as multiple value."
        (push `(,(1+ last-h) . +) res))
      (cl-return (reverse res)))))
 
+(defsubst comp-cstr-set-cmp-range (dst old-dst ext-range)
+  "Support range comparison functions."
+  (with-comp-cstr-accessors
+    (if ext-range
+        (setf (typeset dst) ()
+              (valset dst) ()
+              (range dst) (if (range old-dst)
+                              (comp-range-intersection (range old-dst)
+                                                       ext-range)
+                            ext-range)
+              (neg dst) nil)
+      (setf (typeset dst) (typeset old-dst)
+            (valset dst) (valset old-dst)
+            (range dst) (range old-dst)
+            (neg dst) (neg old-dst)))))
+
 
 ;;; Union specific code.
 
@@ -663,6 +679,58 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
 
 ;;; Entry points.
 
+(defun comp-cstr-> (dst old-dst src)
+  "Constraint DST being > than SRC.
+SRC can be either a comp-cstr or an integer."
+  (with-comp-cstr-accessors
+    (let ((ext-range
+           (if (integerp src)
+               `((,(1+ src) . +))
+             (when-let* ((range (range src))
+                         (low (cdar (last range)))
+                         (okay (integerp low)))
+               `((,(1+ low) . +))))))
+      (comp-cstr-set-cmp-range dst old-dst ext-range))))
+
+(defun comp-cstr->= (dst old-dst src)
+  "Constraint DST being >= than SRC.
+SRC can be either a comp-cstr or an integer."
+  (with-comp-cstr-accessors
+    (let ((ext-range
+           (if (integerp src)
+               `((,src . +))
+             (when-let* ((range (range src))
+                         (low (cdar (last range)))
+                         (okay (integerp low)))
+               `((,low . +))))))
+      (comp-cstr-set-cmp-range dst old-dst ext-range))))
+
+(defun comp-cstr-< (dst old-dst src)
+  "Constraint DST being < than SRC.
+SRC can be either a comp-cstr or an integer."
+  (with-comp-cstr-accessors
+    (let ((ext-range
+           (if (integerp src)
+               `((- . ,(1- src)))
+             (when-let* ((range (range src))
+                         (low (caar (last range)))
+                         (okay (integerp low)))
+               `((- . ,(1- low)))))))
+      (comp-cstr-set-cmp-range dst old-dst ext-range))))
+
+(defun comp-cstr-<= (dst old-dst src)
+  "Constraint DST being > than SRC.
+SRC can be either a comp-cstr or an integer."
+  (with-comp-cstr-accessors
+    (let ((ext-range
+           (if (integerp src)
+               `((- . ,src))
+             (when-let* ((range (range src))
+                         (low (caar (last range)))
+                         (okay (integerp low)))
+               `((- . ,low))))))
+      (comp-cstr-set-cmp-range dst old-dst ext-range))))
+
 (defun comp-cstr-union-no-range (dst &rest srcs)
   "Combine SRCS by union set operation setting the result in DST.
 Do not propagate the range component.