From c4749cebeb68d75456d5ea9188323276f26d5b43 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 12 Nov 2020 15:08:44 +0100 Subject: [PATCH] * Move phi function code into dedicated function and improve it * lisp/emacs-lisp/comp.el (comp-phi): New function moving logic from `comp-fwprop-insn'. --- lisp/emacs-lisp/comp.el | 67 ++++++++++++++++++++++++----------------- 1 file changed, 40 insertions(+), 27 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index c863c29991f..2c871ee7fc7 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2437,6 +2437,45 @@ Forward propagate immediate involed in assignments." (value (comp-apply-in-env f (mapcar #'comp-mvar-value args)))) (rewrite-insn-as-setimm insn value))))))) +(defun comp-phi (lval &rest rvals) + "Phi function propagating RVALS into LVAL. +Return LVAL." + (let* ((rhs-mvars (mapcar #'car rvals)) + (values (mapcar #'comp-mvar-valset rhs-mvars)) + (from-latch (cl-some + (lambda (x) + (comp-latch-p + (gethash (cdr x) + (comp-func-blocks comp-func)))) + rvals))) + + ;; Type propagation. + (setf (comp-mvar-typeset lval) + (apply #'comp-union-typesets (mapcar #'comp-mvar-typeset rhs-mvars))) + + ;; Value propagation. + (setf (comp-mvar-valset lval) + (cl-loop + for v in (cl-remove-duplicates (apply #'append values) + :test #'equal) + ;; We propagate only values those types are not already + ;; into typeset. + when (cl-notany (lambda (x) + (comp-subtype-p (type-of v) x)) + (comp-mvar-typeset lval)) + collect v)) + + ;; Range propagation + (setf (comp-mvar-range lval) + (when (and (not from-latch) + (cl-notany (lambda (x) + (comp-subtype-p 'integer x)) + (comp-mvar-typeset lval))) + ;; TODO memoize? + (apply #'comp-range-union + (mapcar #'comp-mvar-range rhs-mvars)))) + lval)) + (defun comp-fwprop-insn (insn) "Propagate within INSN." (pcase insn @@ -2477,33 +2516,7 @@ Forward propagate immediate involed in assignments." (`(setimm ,lval ,v) (setf (comp-mvar-value lval) v)) (`(phi ,lval . ,rest) - (let* ((rvals (mapcar #'car rest)) - (values (mapcar #'comp-mvar-valset rvals)) - (from-latch (cl-some - (lambda (x) - (comp-latch-p - (gethash (cdr x) - (comp-func-blocks comp-func)))) - rest))) - - ;; Type propagation. - (setf (comp-mvar-typeset lval) - (apply #'comp-union-typesets (mapcar #'comp-mvar-typeset rvals))) - ;; Value propagation. - (setf (comp-mvar-valset lval) - (when (cl-every #'consp values) - ;; TODO memoize? - (cl-remove-duplicates (apply #'append values) - :test #'equal))) - ;; Range propagation - (setf (comp-mvar-range lval) - (when (and (not from-latch) - (cl-notany (lambda (x) - (comp-subtype-p 'integer x)) - (comp-mvar-typeset lval))) - ;; TODO memoize? - (apply #'comp-range-union - (mapcar #'comp-mvar-range rvals)))))))) + (apply #'comp-phi lval rest)))) (defun comp-fwprop* () "Propagate for set* and phi operands. -- 2.39.5