Merge remote-tracking branch 'savannah/master' into native-comp

1 files changed, 42 insertions, 46 deletions

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 8851f0ef32d..e0feb95a461 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -458,16 +458,22 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
        (cons fn (byte-optimize-body exps for-effect)))
 
       (`(if ,test ,then . ,else)
+       ;; FIXME: We are conservative here: any variable changed in the
+       ;; THEN branch will be barred from substitution in the ELSE
+       ;; branch, despite the branches being mutually exclusive.
+
        ;; The test is always executed.
        (let* ((test-opt (byte-optimize-form test nil))
-              ;; The THEN and ELSE branches are executed conditionally.
-              ;;
-              ;; FIXME: We are conservative here: any variable changed in the
-              ;; THEN branch will be barred from substitution in the ELSE
-              ;; branch, despite the branches being  mutually exclusive.
-              (byte-optimize--vars-outside-condition byte-optimize--lexvars)
-              (then-opt (byte-optimize-form then for-effect))
-              (else-opt (byte-optimize-body else for-effect)))
+              (const (macroexp-const-p test-opt))
+              ;; The branches are traversed unconditionally when possible.
+              (byte-optimize--vars-outside-condition
+               (if const
+                   byte-optimize--vars-outside-condition
+                 byte-optimize--lexvars))
+              ;; Avoid traversing dead branches.
+              (then-opt (and test-opt (byte-optimize-form then for-effect)))
+              (else-opt (and (not (and test-opt const))
+                             (byte-optimize-body else for-effect))))
          `(if ,test-opt ,then-opt . ,else-opt)))
 
       (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
@@ -587,16 +593,15 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
                   (lexvar (assq var byte-optimize--lexvars))
                   (value (byte-optimize-form expr nil)))
              (when lexvar
-               ;; If it's bound outside conditional, invalidate.
-               (if (assq var byte-optimize--vars-outside-condition)
-                   ;; We are in conditional code and the variable was
-                   ;; bound outside: cancel substitutions.
-                   (setcdr (cdr lexvar) nil)
-                 ;; Set a new value (if substitutable).
-                 (setcdr (cdr lexvar)
-                         (and (byte-optimize--substitutable-p value)
-                              (list value))))
-               (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+               ;; Set a new value or inhibit further substitution.
+               (setcdr (cdr lexvar)
+                       (and
+                        ;; Inhibit if bound outside conditional code.
+                        (not (assq var byte-optimize--vars-outside-condition))
+                        ;; The new value must be substitutable.
+                        (byte-optimize--substitutable-p value)
+                        (list value)))
+               (setcar (cdr lexvar) t))   ; Mark variable to be kept.
              (push var var-expr-list)
              (push value var-expr-list))
            (setq args (cddr args)))
@@ -638,30 +643,24 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
 
 (defun byte-optimize-form (form &optional for-effect)
   "The source-level pass of the optimizer."
-  ;;
-  ;; First, optimize all sub-forms of this one.
-  (setq form (byte-optimize-form-code-walker form for-effect))
-  ;;
-  ;; after optimizing all subforms, optimize this form until it doesn't
-  ;; optimize any further.  This means that some forms will be passed through
-  ;; the optimizer many times, but that's necessary to make the for-effect
-  ;; processing do as much as possible.
-  ;;
-  (let (opt new)
-    (if (and (consp form)
-	     (symbolp (car form))
-	     (or ;; (and for-effect
-		 ;;      ;; We don't have any of these yet, but we might.
-		 ;;      (setq opt (get (car form)
-                 ;;                     'byte-for-effect-optimizer)))
-		 (setq opt (function-get (car form) 'byte-optimizer)))
-	     (not (eq form (setq new (funcall opt form)))))
-	(progn
-;;	  (if (equal form new) (error "bogus optimizer -- %s" opt))
-	  (byte-compile-log "  %s\t==>\t%s" form new)
-	  (setq new (byte-optimize-form new for-effect))
-	  new)
-      form)))
+  (while
+      (progn
+        ;; First, optimize all sub-forms of this one.
+        (setq form (byte-optimize-form-code-walker form for-effect))
+
+        ;; If a form-specific optimiser is available, run it and start over
+        ;; until a fixpoint has been reached.
+        (and (consp form)
+             (symbolp (car form))
+             (let ((opt (function-get (car form) 'byte-optimizer)))
+               (and opt
+                    (let ((old form)
+                          (new (funcall opt form)))
+	              (byte-compile-log "  %s\t==>\t%s" old new)
+                      (setq form new)
+                      (not (eq new old))))))))
+  ;; Normalise (quote nil) to nil, for a single representation of constant nil.
+  (and (not (equal form '(quote nil))) form))
 
 (defun byte-optimize-let-form (head form for-effect)
   ;; Recursively enter the optimizer for the bindings and body
@@ -1563,10 +1562,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
              ;; so we create a copy of it, and replace the addresses with
              ;; TAGs.
              (let ((orig-table last-constant))
-               (cl-loop for e across constvec
-                        when (eq e last-constant)
-                        do (setq last-constant (copy-hash-table e))
-                        and return nil)
+               (setq last-constant (copy-hash-table last-constant))
                ;; Replace all addresses with TAGs.
                (maphash #'(lambda (value offset)
                             (let ((match (assq offset tags)))