1 files changed, 63 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index d41501e6804..28cffcf0661 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -280,6 +280,22 @@ Return them as multiple value."
       x
     (1- x)))
 
+(defsubst comp-range-+ (x y)
+  (pcase (cons x y)
+    ((or '(+ . -) '(- . +)) '??)
+    ((or `(- . ,_) `(,_ . -)) '-)
+    ((or `(+ . ,_) `(,_ . +)) '+)
+    (_ (+ x y))))
+
+(defsubst comp-range-- (x y)
+  (pcase (cons x y)
+    ((or '(+ . +) '(- . -)) '??)
+    ('(+ . -) '+)
+    ('(- . +) '-)
+    ((or `(+ . ,_) `(,_ . -)) '+)
+    ((or `(- . ,_) `(,_ . +)) '-)
+    (_ (- x y))))
+
 (defsubst comp-range-< (x y)
   (cond
    ((eq x '+) nil)
@@ -389,6 +405,39 @@ Return them as multiple value."
             (range dst) (range old-dst)
             (neg dst) (neg old-dst)))))
 
+(defmacro comp-cstr-set-range-for-arithm (dst src1 src2 &rest range-body)
+  ;; Prevent some code duplication for `comp-cstr-add-2'
+  ;; `comp-cstr-sub-2'.
+  (declare (debug (range-body))
+           (indent defun))
+  `(with-comp-cstr-accessors
+     (when-let ((r1 (range ,src1))
+                (r2 (range ,src2)))
+       (let* ((l1 (comp-cstr-smallest-in-range r1))
+              (l2 (comp-cstr-smallest-in-range r2))
+              (h1 (comp-cstr-greatest-in-range r1))
+              (h2 (comp-cstr-greatest-in-range r2)))
+         (setf (typeset ,dst) (when (cl-some (lambda (x)
+                                               (comp-subtype-p 'float x))
+                                             (append (typeset src1)
+                                                     (typeset src2)))
+                                '(float))
+               (range ,dst) ,@range-body)))))
+
+(defun comp-cstr-add-2 (dst src1 src2)
+  "Sum SRC1 and SRC2 into DST."
+  (comp-cstr-set-range-for-arithm dst src1 src2
+    `((,(comp-range-+ l1 l2) . ,(comp-range-+ h1 h2)))))
+
+(defun comp-cstr-sub-2 (dst src1 src2)
+  "Subtract SRC1 and SRC2 into DST."
+  (comp-cstr-set-range-for-arithm dst src1 src2
+    (let ((l (comp-range-- l1 h2))
+          (h (comp-range-- h1 l2)))
+      (if (or (eq l '??) (eq h '??))
+          '((- . +))
+        `((,l . ,h))))))
+
 
 ;;; Union specific code.
 
@@ -742,6 +791,20 @@ SRC can be either a comp-cstr or an integer."
                `((- . ,low))))))
       (comp-cstr-set-cmp-range dst old-dst ext-range))))
 
+(defun comp-cstr-add (dst srcs)
+  "Sum SRCS into DST."
+  (comp-cstr-add-2 dst (cl-first srcs) (cl-second srcs))
+  (cl-loop
+   for src in (nthcdr 2 srcs)
+   do (comp-cstr-add-2 dst dst src)))
+
+(defun comp-cstr-sub (dst srcs)
+  "Subtract SRCS into DST."
+  (comp-cstr-sub-2 dst (cl-first srcs) (cl-second srcs))
+  (cl-loop
+   for src in (nthcdr 2 srcs)
+   do (comp-cstr-sub-2 dst dst src)))
+
 (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.