master 8d0ee5e 4/7: Constant-propagate variables bound outside loops

[Mattias Engdegård]

branch: master
commit 8d0ee5e7a9d635a625f87fd8c6eed39a8a749131
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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.
---
 lisp/emacs-lisp/byte-opt.el            | 52 ++++++++++++++++++++++------------
 test/lisp/emacs-lisp/bytecomp-tests.el | 37 ++++++++++++++++++++++++
 2 files changed, 71 insertions(+), 18 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index c15814a..c8a96fa 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 2832dd0..ded6351 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)