mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-03 08:30:09 +00:00
Code Issues Releases Activity

Constant-propagate variables bound outside loops

Browse Source 
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.
This commit is contained in:
Mattias Engdegård 2021-09-22 11:03:30 +02:00
parent 32de11d8de
commit 8d0ee5e7a9
2 changed files with 71 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
lisp/emacs-lisp/byte-opt.el
View File

@ -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)))

37
test/lisp/emacs-lisp/bytecomp-tests.el
View File

@ -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)