procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/comp.el (comp-fwprop-insn): Fix phi function.

Browse source
This commit is contained in:
Andrea Corallo 2020-11-08 20:45:43 +01:00
parent a5408d5715
commit e20cdf937e
1 changed files with 14 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

27
lisp/emacs-lisp/comp.el
View file

@ -2289,19 +2289,20 @@ Forward propagate immediate involed in assignments."
(setf (comp-mvar-const-vld lval) t (setf (comp-mvar-const-vld lval) t
(comp-mvar-constant lval) v (comp-mvar-constant lval) v
(comp-mvar-type lval) (comp-strict-type-of v))) (comp-mvar-type lval) (comp-strict-type-of v)))
(`(phi (,lval . _) . ,rest) (`(phi ,lval . ,rest)
;; Forward const prop here. (let ((rvals (mapcar #'car rest)))
(when-let* ((vld (cl-every #'comp-mvar-const-vld rest)) ;; Forward const prop here.
(consts (mapcar #'comp-mvar-constant rest)) (when-let* ((vld (cl-every #'comp-mvar-const-vld rvals))
(x (car consts)) (consts (mapcar #'comp-mvar-constant rvals))
(equals (cl-every (lambda (y) (equal x y)) consts))) (x (car consts))
(setf (comp-mvar-const-vld lval) t (equals (cl-every (lambda (y) (equal x y)) consts)))
(comp-mvar-constant lval) x)) (setf (comp-mvar-const-vld lval) t
;; Forward type propagation. (comp-mvar-constant lval) x))
(when-let* ((types (mapcar #'comp-mvar-type rest)) ;; Forward type propagation.
(non-empty (cl-notany #'null types)) (when-let* ((types (mapcar #'comp-mvar-type rvals))
(x (comp-common-supertype types))) (non-empty (cl-notany #'null types))
(setf (comp-mvar-type lval) x))))) (x (comp-common-supertype types)))
(setf (comp-mvar-type lval) x))))))
(defun comp-fwprop* () (defun comp-fwprop* ()
"Propagate for set* and phi operands. "Propagate for set* and phi operands.