Make use of `comp-cstr-shallow-copy'

* lisp/emacs-lisp/comp.el (comp-mvar-propagate): Remove.
(comp-fwprop-call, comp-fwprop-insn): Use `comp-cstr-shallow-copy'.

* lisp/emacs-lisp/comp-cstr.el (comp-cstr-set-cmp-range)
(comp-cstr-union-1-no-mem, comp-cstr-union-1)
(comp-cstr-intersection-no-mem, comp-cstr-intersection)
(comp-cstr-negation): Use `comp-cstr-shallow-copy'.

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 7f0af2aaee5bf01eb8368a5c7c8a6c7c6bf80fb2..3e816195209cfcb6298f261b8988928e40ebdcf1 100644 (file)
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -446,10 +446,7 @@ Return them as multiple value."
                                                        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)))))
+      (comp-cstr-shallow-copy dst old-dst))))
 
 (defmacro comp-cstr-set-range-for-arithm (dst src1 src2 &rest range-body)
   ;; Prevent some code duplication for `comp-cstr-add-2'
@@ -589,10 +586,8 @@ DST is returned."
                                                     (when (range pos)
                                                       '(integer)))))
                                  (typeset neg)))
-              (setf (typeset dst) (typeset pos)
-                    (valset dst) (valset pos)
-                    (range dst) (range pos)
-                    (neg dst) nil)
+              (comp-cstr-shallow-copy dst pos)
+              (setf (neg dst) nil)
               (cl-return-from comp-cstr-union-1-no-mem dst))
 
             ;; Verify disjoint condition between positive types and
@@ -639,15 +634,9 @@ DST is returned."
                         (comp-range-negation (range neg))
                         (range pos))))))
 
-            (if (comp-cstr-empty-p neg)
-                (setf (typeset dst) (typeset pos)
-                      (valset dst) (valset pos)
-                      (range dst) (range pos)
-                      (neg dst) nil)
-              (setf (typeset dst) (typeset neg)
-                    (valset dst) (valset neg)
-                    (range dst) (range neg)
-                    (neg dst) (neg neg)))))
+            (comp-cstr-shallow-copy dst (if (comp-cstr-empty-p neg)
+                                            pos
+                                          neg))))
 
         ;; (not null) => t
         (when (and (neg dst)
@@ -671,10 +660,7 @@ DST is returned."
                      (mapcar #'comp-cstr-copy srcs)
                      (apply #'comp-cstr-union-1-no-mem range srcs)
                      mem-h))))
-      (setf (typeset dst) (typeset res)
-            (valset dst) (valset res)
-            (range dst) (range res)
-            (neg dst) (neg res))
+      (comp-cstr-shallow-copy dst res)
       res)))
 
 (cl-defun comp-cstr-intersection-homogeneous (dst &rest srcs)
@@ -761,10 +747,8 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
             ;; In case pos is not relevant return directly the content
             ;; of neg.
             (when (equal (typeset pos) '(t))
-              (setf (typeset dst) (typeset neg)
-                    (valset dst) (valset neg)
-                    (range dst) (range neg)
-                    (neg dst) t)
+              (comp-cstr-shallow-copy dst neg)
+              (setf (neg dst) t)
 
               ;; (not t) => nil
               (when (and (null (valset dst))
@@ -808,10 +792,8 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
                   (cl-set-difference (valset pos) (valset neg)))
 
             ;; Return a non negated form.
-            (setf (typeset dst) (typeset pos)
-                  (valset dst) (valset pos)
-                  (range dst) (range pos)
-                  (neg dst) nil)))
+            (comp-cstr-shallow-copy dst pos)
+            (setf (neg dst) nil)))
         dst))))
 
 \f
@@ -1016,10 +998,7 @@ DST is returned."
                      (mapcar #'comp-cstr-copy srcs)
                      (apply #'comp-cstr-intersection-no-mem srcs)
                      mem-h))))
-      (setf (typeset dst) (typeset res)
-            (valset dst) (valset res)
-            (range dst) (range res)
-            (neg dst) (neg res))
+      (comp-cstr-shallow-copy dst res)
       res)))
 
 (defun comp-cstr-intersection-no-hashcons (dst &rest srcs)
@@ -1075,10 +1054,9 @@ DST is returned."
             (valset dst) ()
             (range dst) nil
             (neg dst) nil))
-     (t (setf (typeset dst) (typeset src)
-              (valset dst) (valset src)
-              (range dst) (range src)
-              (neg dst) (not (neg src)))))
+     (t
+      (comp-cstr-shallow-copy dst src)
+      (setf (neg dst) (not (neg src)))))
     dst))
 
 (defun comp-cstr-value-negation (dst src)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 0a105052570b194887e08d0d3b70172d0487fec5..b51224088f1afefa5b5da382a4ffeef76c8c9a27 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3086,13 +3086,6 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo.  Involved or
             (`(setimm ,lval ,v)
              (setf (comp-cstr-imm lval) v))))))
 
-(defun comp-mvar-propagate (lval rval)
-  "Propagate into LVAL properties of RVAL."
-  (setf (comp-mvar-typeset lval) (comp-mvar-typeset rval)
-        (comp-mvar-valset lval) (comp-mvar-valset rval)
-        (comp-mvar-range lval) (comp-mvar-range rval)
-        (comp-mvar-neg lval) (comp-mvar-neg rval)))
-
 (defun comp-function-foldable-p (f args)
   "Given function F called with ARGS, return non-nil when optimizable."
   (and (comp-function-pure-p f)
@@ -3142,10 +3135,7 @@ Fold the call in case."
         (when (comp-cstr-empty-p cstr)
           ;; Store it to be rewritten as non local exit.
           (setf (comp-block-lap-non-ret-insn comp-block) insn))
-        (setf (comp-mvar-range lval) (comp-cstr-range cstr)
-              (comp-mvar-valset lval) (comp-cstr-valset cstr)
-              (comp-mvar-typeset lval) (comp-cstr-typeset cstr)
-              (comp-mvar-neg lval) (comp-cstr-neg cstr))))
+        (comp-cstr-shallow-copy lval cstr)))
     (cl-case f
       (+ (comp-cstr-add lval args))
       (- (comp-cstr-sub lval args))
@@ -3163,9 +3153,9 @@ Fold the call in case."
         (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt)))))
           (comp-fwprop-call insn lval f args)))
        (_
-        (comp-mvar-propagate lval rval))))
+        (comp-cstr-shallow-copy lval rval))))
     (`(assume ,lval ,(and (pred comp-mvar-p) rval))
-     (comp-mvar-propagate lval rval))
+     (comp-cstr-shallow-copy lval rval))
     (`(assume ,lval (,kind . ,operands))
      (cl-case kind
        (and