From: Mattias Engdegård Date: Wed, 22 Sep 2021 09:03:30 +0000 (+0200) Subject: Constant-propagate variables bound outside loops X-Git-Tag: emacs-28.0.90~629 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8d0ee5e7a9d635a625f87fd8c6eed39a8a749131;p=emacs.git Constant-propagate variables bound outside loops Previously, variables bound outside `while` loops were not substituted inside even in the absense of mutation. Add the necessary mutation checking inside loops to allow propagation of values and aliased variables. * lisp/emacs-lisp/byte-opt.el (byte-optimize--inhibit-outside-loop-constprop): New variable. (byte-optimize-form-code-walker): First traverse each loop without substitution to discover mutation, then without restrictions. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-loop): New. (bytecomp-tests--test-cases): Add test cases. --- diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c15814afa00..c8a96fa22a9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -317,6 +317,10 @@ occur an indeterminate number of times and thus have effect on code sequentially preceding the mutation itself. Same format as `byte-optimize--lexvars', with shared structure and contents.") +(defvar byte-optimize--inhibit-outside-loop-constprop nil + "If t, don't propagate values for variables declared outside the inner loop. +This indicates the loop discovery phase.") + (defvar byte-optimize--dynamic-vars nil "List of variables declared as dynamic during optimisation.") @@ -402,15 +406,13 @@ for speeding up processing.") (cond ((not lexvar) form) (for-effect nil) - ((cddr lexvar) ; Value available? - (if (assq form byte-optimize--vars-outside-loop) - ;; Cannot substitute; mark for retention to avoid the - ;; variable being eliminated. - (progn - (setcar (cdr lexvar) t) - form) - ;; variable value to use - (caddr lexvar))) + ((and (cddr lexvar) ; substitution available + ;; Perform substitution, except during the loop mutation + ;; discovery phase if the variable was bound outside the + ;; innermost loop. + (not (and byte-optimize--inhibit-outside-loop-constprop + (assq form byte-optimize--vars-outside-loop)))) + (caddr lexvar)) (t form)))) (t form))) (`(quote . ,v) @@ -488,14 +490,26 @@ for speeding up processing.") (cons fn (nreverse args)))) (`(while ,exp . ,exps) - ;; FIXME: We conservatively prevent the substitution of any variable - ;; bound outside the loop in case it is mutated later in the loop, - ;; but this misses many opportunities: variables not mutated in the - ;; loop at all, and variables affecting the initial condition (which - ;; is always executed unconditionally). + ;; FIXME: If the loop condition is statically nil after substitution + ;; of surrounding variables then we can eliminate the whole loop, + ;; even if those variables are mutated inside the loop. + ;; We currently don't perform this important optimisation. (let* ((byte-optimize--vars-outside-loop byte-optimize--lexvars) - (condition (byte-optimize-form exp nil)) - (body (byte-optimize-body exps t))) + (condition-body + (if byte-optimize--inhibit-outside-loop-constprop + ;; We are already inside the discovery phase of an outer + ;; loop so there is no need for traversing this loop twice. + (cons exp exps) + ;; Discovery phase: run optimisation without substitution + ;; of variables bound outside this loop. + (let ((byte-optimize--inhibit-outside-loop-constprop t)) + (cons (byte-optimize-form exp nil) + (byte-optimize-body exps t))))) + ;; Optimise again, this time with constprop enabled (unless + ;; we are in discovery of an outer loop), + ;; as mutated variables have been marked as non-substitutable. + (condition (byte-optimize-form (car condition-body) nil)) + (body (byte-optimize-body (cdr condition-body) t))) `(while ,condition . ,body))) (`(interactive . ,_) @@ -793,8 +807,10 @@ for speeding up processing.") (bindings nil)) (dolist (var let-vars) ;; VAR is (NAME EXPR [KEEP [VALUE]]) - (when (or (not (nthcdr 3 var)) (nth 2 var)) - ;; Value not present, or variable marked to be kept. + (when (or (not (nthcdr 3 var)) (nth 2 var) + byte-optimize--inhibit-outside-loop-constprop) + ;; Value not present, or variable marked to be kept, + ;; or we are in the loop discovery phase: keep the binding. (push (list (nth 0 var) (nth 1 var)) bindings))) (cons bindings opt-body))) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 2832dd02469..ded6351c5ee 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -41,6 +41,24 @@ "Identity, but hidden from some optimisations." x) +(defmacro bytecomp-test-loop (outer1 outer2 inner1 inner2) + "Exercise constant propagation inside `while' loops. +OUTER1, OUTER2, INNER1 and INNER2 are forms placed in the outer and +inner loops respectively." + `(let ((x 1) (i 3) (res nil)) + (while (> i 0) + (let ((y 2) (j 2)) + (setq res (cons (list 'outer x y) res)) + (while (> j 0) + (setq res (cons (list 'inner x y) res)) + ,inner1 + ,inner2 + (setq j (1- j))) + ,outer1 + ,outer2) + (setq i (1- i))) + res)) + (defconst bytecomp-tests--test-cases '( ;; some functional tests @@ -454,6 +472,25 @@ (setq x 10)))) 4) + ;; Loop constprop: set the inner and outer variables in the inner + ;; and outer loops, all combinations. + (bytecomp-test-loop nil nil nil nil ) + (bytecomp-test-loop nil nil nil (setq x 6)) + (bytecomp-test-loop nil nil (setq x 5) nil ) + (bytecomp-test-loop nil nil (setq x 5) (setq x 6)) + (bytecomp-test-loop nil (setq x 4) nil nil ) + (bytecomp-test-loop nil (setq x 4) nil (setq x 6)) + (bytecomp-test-loop nil (setq x 4) (setq x 5) nil ) + (bytecomp-test-loop nil (setq x 4) (setq x 5) (setq x 6)) + (bytecomp-test-loop (setq x 3) nil nil nil ) + (bytecomp-test-loop (setq x 3) nil nil (setq x 6)) + (bytecomp-test-loop (setq x 3) nil (setq x 5) nil ) + (bytecomp-test-loop (setq x 3) nil (setq x 5) (setq x 6)) + (bytecomp-test-loop (setq x 3) (setq x 4) nil nil ) + (bytecomp-test-loop (setq x 3) (setq x 4) nil (setq x 6)) + (bytecomp-test-loop (setq x 3) (setq x 4) (setq x 5) nil ) + (bytecomp-test-loop (setq x 3) (setq x 4) (setq x 5) (setq x 6)) + ;; No error, no success handler. (condition-case x (list 42)