[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master fd86829 3/3: Make use of `comp-cstr-shallow-copy'
|
From: |
Andrea Corallo |
|
Subject: |
master fd86829 3/3: Make use of `comp-cstr-shallow-copy' |
|
Date: |
Wed, 1 Dec 2021 16:21:39 -0500 (EST) |
branch: master
commit fd86829e6648338282632b9e97b11f1e76299193
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
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'.
---
lisp/emacs-lisp/comp-cstr.el | 52 +++++++++++++-------------------------------
lisp/emacs-lisp/comp.el | 16 +++-----------
2 files changed, 18 insertions(+), 50 deletions(-)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 7f0af2a..3e81619 100644
--- 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))))
@@ -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 0a10505..b512240 100644
--- 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