diff options
Diffstat (limited to 'lisp/emacs-lisp/byte-opt.el')
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 88 |
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))) |