From 83983b6b7a115474572973b62eb5e42251713e63 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 6 Feb 2021 18:34:45 +0100 Subject: Constprop of lexical variables Lexical variables bound to a constant value (symbol, number or string) are substituted at their point of use and the variable then eliminated if possible. Example: (let ((x (+ 2 3))) (f x)) => (f 5) This reduces code size, eliminates stack operations, and enables further optimisations. The implementation is conservative, and is strongly curtailed by the presence of variable mutation, conditions and loops. * lisp/emacs-lisp/byte-opt.el (byte-optimize-enable-variable-constprop) (byte-optimize-warn-eliminated-variable): New constants. (byte-optimize--lexvars, byte-optimize--vars-outside-condition) (byte-optimize--vars-outside-loop, byte-optimize--dynamic-vars): New dynamic variables. (byte-optimize--substitutable-p, byte-optimize-let-form): New functions. (byte-optimize-form-code-walker): Adapt clauses for variable constprop, and add clauses for 'setq' and 'defvar'. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-var) (bytecomp-test-get-var, bytecomp-test-identity) (byte-opt-testsuite-arith-data): Add test cases. --- lisp/emacs-lisp/byte-opt.el | 314 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 244 insertions(+), 70 deletions(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 66a117fccc8..017cad900d8 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -368,6 +368,53 @@ ;;; implementing source-level optimizers +(defconst byte-optimize-enable-variable-constprop t + "If non-nil, enable constant propagation through local variables.") + +(defconst byte-optimize-warn-eliminated-variable nil + "Whether to warn when a variable is optimised away entirely. +This does usually not indicate a problem and makes the compiler +very chatty, but can be useful for debugging.") + +(defvar byte-optimize--lexvars nil + "Lexical variables in scope, in reverse order of declaration. +Each element is on the form (NAME CHANGED [VALUE]), where: + NAME is the variable name, + CHANGED is a boolean indicating whether it's been changed (with setq), + VALUE, if present, is a substitutable expression. +Earlier variables shadow later ones with the same name.") + +(defvar byte-optimize--vars-outside-condition nil + "Alist of variables lexically bound outside conditionally executed code. +Variables here are sensitive to mutation inside the condition, since such +changes may not be effective for all code paths. +Same format as `byte-optimize--lexvars', with shared structure and contents.") + +(defvar byte-optimize--vars-outside-loop nil + "Alist of variables lexically bound outside the innermost `while' loop. +Variables here are sensitive to mutation inside the loop, since this can +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--dynamic-vars nil + "List of variables declared as dynamic during optimisation.") + +(defun byte-optimize--substitutable-p (expr) + "Whether EXPR is a constant that can be propagated." + ;; Only consider numbers, symbols and strings to be values for substitution + ;; purposes. Numbers and symbols are immutable, and mutating string + ;; literals (or results from constant-evaluated string-returning functions) + ;; can be considered undefined. + ;; (What about other quoted values, like conses?) + (or (booleanp expr) + (numberp expr) + (stringp expr) + (and (consp expr) + (eq (car expr) 'quote) + (symbolp (cadr expr))) + (keywordp expr))) + (defun byte-optimize-form-code-walker (form for-effect) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But @@ -382,11 +429,24 @@ (let ((fn (car-safe form))) (pcase form ((pred (not consp)) - (if (not (and for-effect - (or byte-compile-delete-errors - (not (symbolp form)) - (eq form t)))) - form)) + (cond + ((and for-effect + (or byte-compile-delete-errors + (not (symbolp form)) + (eq form t))) + nil) + ((symbolp form) + (let ((lexvar (assq form byte-optimize--lexvars))) + (if (cddr lexvar) ; Value available? + (if (assq form byte-optimize--vars-outside-loop) + ;; Cannot substitute; mark as changed to avoid the + ;; variable being eliminated. + (progn + (setcar (cdr lexvar) t) + form) + (caddr lexvar)) ; variable value to use + form))) + (t form))) (`(quote . ,v) (if (cdr v) (byte-compile-warn "malformed quote form: `%s'" @@ -396,33 +456,22 @@ (and (car v) (not for-effect) form)) - (`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare)) - ;; Recursively enter the optimizer for the bindings and body - ;; of a let or let*. This for depth-firstness: forms that - ;; are more deeply nested are optimized first. - (cons fn - (cons - (mapcar (lambda (binding) - (if (symbolp binding) - binding - (if (cdr (cdr binding)) - (byte-compile-warn "malformed let binding: `%s'" - (prin1-to-string binding))) - (list (car binding) - (byte-optimize-form (nth 1 binding) nil)))) - bindings) - (byte-optimize-body exps for-effect)))) + (`(,(or 'let 'let*) . ,rest) + (cons fn (byte-optimize-let-form fn rest for-effect))) (`(cond . ,clauses) - (cons fn - (mapcar (lambda (clause) - (if (consp clause) - (cons - (byte-optimize-form (car clause) nil) - (byte-optimize-body (cdr clause) for-effect)) - (byte-compile-warn "malformed cond form: `%s'" - (prin1-to-string clause)) - clause)) - clauses))) + ;; The condition in the first clause is always executed, but + ;; right now we treat all of them as conditional for simplicity. + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + (cons fn + (mapcar (lambda (clause) + (if (consp clause) + (cons + (byte-optimize-form (car clause) nil) + (byte-optimize-body (cdr clause) for-effect)) + (byte-compile-warn "malformed cond form: `%s'" + (prin1-to-string clause)) + clause)) + clauses)))) (`(progn . ,exps) ;; As an extra added bonus, this simplifies (progn ) --> . (if (cdr exps) @@ -442,35 +491,54 @@ (cons fn (byte-optimize-body exps for-effect))) (`(if ,test ,then . ,else) - `(if ,(byte-optimize-form test nil) - ,(byte-optimize-form then for-effect) - . ,(byte-optimize-body else for-effect))) + ;; 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))) + `(if ,test-opt ,then-opt . ,else-opt))) (`(if . ,_) (byte-compile-warn "too few arguments for `if'")) (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. - ;; Take forms off the back until we can't any more. - ;; In the future it could conceivably be a problem that the - ;; subexpressions of these forms are optimized in the reverse - ;; order, but it's ok for now. - (if for-effect - (let ((backwards (reverse exps))) - (while (and backwards - (null (setcar backwards - (byte-optimize-form (car backwards) - for-effect)))) - (setq backwards (cdr backwards))) - (if (and exps (null backwards)) - (byte-compile-log - " all subforms of %s called for effect; deleted" form)) - (and backwards - (cons fn (nreverse (mapcar #'byte-optimize-form - backwards))))) - (cons fn (mapcar #'byte-optimize-form exps)))) + ;; FIXME: We have to traverse the expressions in left-to-right + ;; order, but doing so we miss some optimisation opportunities: + ;; consider (and A B) in a for-effect context, where B => nil. + ;; Then A could be optimised in a for-effect context too. + (let ((tail exps) + (args nil)) + (when tail + ;; The first argument is always unconditional. + (push (byte-optimize-form + (car tail) (and for-effect (null (cdr tail)))) + args) + (setq tail (cdr tail)) + ;; Remaining arguments are conditional. + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + (while tail + (push (byte-optimize-form + (car tail) (and for-effect (null (cdr tail)))) + args) + (setq tail (cdr tail))))) + (cons fn (nreverse args)))) (`(while ,exp . ,exps) - `(while ,(byte-optimize-form exp nil) - . ,(byte-optimize-body exps t))) + ;; 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). + (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) + (byte-optimize--vars-outside-loop byte-optimize--lexvars) + (condition (byte-optimize-form exp nil)) + (body (byte-optimize-body exps t))) + `(while ,condition . ,body))) + (`(while . ,_) (byte-compile-warn "too few arguments for `while'")) @@ -485,24 +553,35 @@ form) (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare)) - `(condition-case ,var ;Not evaluated. - ,(byte-optimize-form exp for-effect) - ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) - clauses))) - - (`(unwind-protect . ,(or `(,exp . ,exps) pcase--dontcare)) - ;; The "protected" part of an unwind-protect is compiled (and thus - ;; optimized) as a top-level form, so don't do it here. But the - ;; non-protected part has the same for-effect status as the - ;; unwind-protect itself. (The protected part is always for effect, + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + `(condition-case ,var ;Not evaluated. + ,(byte-optimize-form exp for-effect) + ,@(mapcar (lambda (clause) + `(,(car clause) + ,@(byte-optimize-body (cdr clause) for-effect))) + clauses)))) + + (`(unwind-protect ,exp . ,exps) + ;; The unwinding part of an unwind-protect is compiled (and thus + ;; optimized) as a top-level form, but run the optimizer for it here + ;; anyway for lexical variable usage and substitution. But the + ;; protected part has the same for-effect status as the + ;; unwind-protect itself. (The unwinding part is always for effect, ;; but that isn't handled properly yet.) - `(unwind-protect ,(byte-optimize-form exp for-effect) . ,exps)) + (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) + (bodyform (byte-optimize-form exp for-effect))) + (pcase exps + (`(:fun-body ,f) + `(unwind-protect ,bodyform + :fun-body ,(byte-optimize-form f nil))) + (_ + `(unwind-protect ,bodyform + . ,(byte-optimize-body exps t)))))) (`(catch . ,(or `(,tag . ,exps) pcase--dontcare)) - `(catch ,(byte-optimize-form tag nil) - . ,(byte-optimize-body exps for-effect))) + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + `(catch ,(byte-optimize-form tag nil) + . ,(byte-optimize-body exps for-effect)))) (`(ignore . ,exps) ;; Don't treat the args to `ignore' as being @@ -512,7 +591,14 @@ `(prog1 nil . ,(mapcar #'byte-optimize-form exps))) ;; Needed as long as we run byte-optimize-form after cconv. - (`(internal-make-closure . ,_) form) + (`(internal-make-closure . ,_) + ;; Look up free vars and mark them as changed, so that they + ;; won't be optimised away. + (dolist (var (caddr form)) + (let ((lexvar (assq var byte-optimize--lexvars))) + (when lexvar + (setcar (cdr lexvar) t)))) + form) (`((lambda . ,_) . ,_) (let ((newform (byte-compile-unfold-lambda form))) @@ -525,6 +611,35 @@ ;; is a *value* and shouldn't appear in the car. (`((closure . ,_) . ,_) form) + (`(setq . ,args) + (let ((var-expr-list nil)) + (while args + (unless (and (consp args) + (symbolp (car args)) (consp (cdr args))) + (byte-compile-warn "malformed setq form: %S" form)) + (let* ((var (car args)) + (expr (cadr args)) + (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) + (setcdr (cdr lexvar) + (and (byte-optimize--substitutable-p value) + (list value)))) + (setcar (cdr lexvar) t)) ; Mark variable as changed. + (push var var-expr-list) + (push value var-expr-list)) + (setq args (cddr args))) + (cons fn (nreverse var-expr-list)))) + + (`(defvar ,(and (pred symbolp) name) . ,_) + (push name byte-optimize--dynamic-vars) + form) + (`(,(pred byte-code-function-p) . ,exps) (cons fn (mapcar #'byte-optimize-form exps))) @@ -582,6 +697,64 @@ new) form))) +(defun byte-optimize-let-form (head form for-effect) + ;; Recursively enter the optimizer for the bindings and body + ;; of a let or let*. This for depth-firstness: forms that + ;; are more deeply nested are optimized first. + (if (and lexical-binding byte-optimize-enable-variable-constprop) + (let* ((byte-optimize--lexvars byte-optimize--lexvars) + (new-lexvars nil) + (let-vars nil)) + (dolist (binding (car form)) + (let (name expr) + (cond ((consp binding) + (setq name (car binding)) + (unless (symbolp name) + (byte-compile-warn "let-bind nonvariable: `%S'" name)) + (setq expr (byte-optimize-form (cadr binding) nil))) + ((symbolp binding) + (setq name binding)) + (t (byte-compile-warn "malformed let binding: `%S'" binding))) + (let* ( + (value (and (byte-optimize--substitutable-p expr) + (list expr))) + (lexical (not (or (and (symbolp name) + (special-variable-p name)) + (memq name byte-compile-bound-variables) + (memq name byte-optimize--dynamic-vars)))) + (lexinfo (and lexical (cons name (cons nil value))))) + (push (cons name (cons expr (cdr lexinfo))) let-vars) + (when lexinfo + (push lexinfo (if (eq head 'let*) + byte-optimize--lexvars + new-lexvars)))))) + (setq byte-optimize--lexvars + (append new-lexvars byte-optimize--lexvars)) + ;; Walk the body expressions, which may mutate some of the records, + ;; and generate new bindings that exclude unused variables. + (let* ((opt-body (byte-optimize-body (cdr form) for-effect)) + (bindings nil)) + (dolist (var let-vars) + ;; VAR is (NAME EXPR [CHANGED [VALUE]]) + (if (and (nthcdr 3 var) (not (nth 2 var))) + (when byte-optimize-warn-eliminated-variable + (byte-compile-warn "eliminating local variable %S" (car var))) + (push (list (nth 0 var) (nth 1 var)) bindings))) + (cons bindings opt-body))) + + ;; With dynamic binding, no substitutions are in effect. + (let ((byte-optimize--lexvars nil)) + (cons + (mapcar (lambda (binding) + (if (symbolp binding) + binding + (when (or (atom binding) (cddr binding)) + (byte-compile-warn "malformed let binding: `%S'" binding)) + (list (car binding) + (byte-optimize-form (nth 1 binding) nil)))) + (car form)) + (byte-optimize-body (cdr form) for-effect))))) + (defun byte-optimize-body (forms all-for-effect) ;; Optimize the cdr of a progn or implicit progn; all forms is a list of @@ -590,6 +763,7 @@ ;; all-for-effect is true. returns a new list of forms. (let ((rest forms) (result nil) + (byte-optimize--dynamic-vars byte-optimize--dynamic-vars) fe new) (while rest (setq fe (or all-for-effect (cdr rest))) -- cgit v1.2.3 From 765ffeb54569c1679b9f08b50c6a88fe50c525c8 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 7 Feb 2021 10:35:36 +0100 Subject: ; Improved commentary in the variable constprop mechanism * lisp/emacs-lisp/byte-opt.el (byte-optimize--lexvars) (byte-optimize--vars-outside-condition) (byte-optimize-form-code-walker, byte-optimize-let-form): Clarify various aspects in the variable constant-propagation code, as kindly pointed out by Stefan Monnier. --- lisp/emacs-lisp/byte-opt.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 017cad900d8..32f66ebebb9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -378,16 +378,17 @@ very chatty, but can be useful for debugging.") (defvar byte-optimize--lexvars nil "Lexical variables in scope, in reverse order of declaration. -Each element is on the form (NAME CHANGED [VALUE]), where: +Each element is on the form (NAME KEEP [VALUE]), where: NAME is the variable name, - CHANGED is a boolean indicating whether it's been changed (with setq), + KEEP is a boolean indicating whether the binding must be retained, VALUE, if present, is a substitutable expression. Earlier variables shadow later ones with the same name.") (defvar byte-optimize--vars-outside-condition nil "Alist of variables lexically bound outside conditionally executed code. -Variables here are sensitive to mutation inside the condition, since such -changes may not be effective for all code paths. +Variables here are sensitive to mutation inside the conditional code, +since their contents in sequentially later code depends on the path taken +and may no longer be statically known. Same format as `byte-optimize--lexvars', with shared structure and contents.") (defvar byte-optimize--vars-outside-loop nil @@ -507,7 +508,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. ;; FIXME: We have to traverse the expressions in left-to-right - ;; order, but doing so we miss some optimisation opportunities: + ;; order (because that is the order of evaluation and variable + ;; mutations must be found prior to their use), but doing so we miss + ;; some optimisation opportunities: ;; consider (and A B) in a for-effect context, where B => nil. ;; Then A could be optimised in a for-effect context too. (let ((tail exps) @@ -592,7 +595,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; Needed as long as we run byte-optimize-form after cconv. (`(internal-make-closure . ,_) - ;; Look up free vars and mark them as changed, so that they + ;; Look up free vars and mark them to be kept, so that they ;; won't be optimised away. (dolist (var (caddr form)) (let ((lexvar (assq var byte-optimize--lexvars))) @@ -627,10 +630,11 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; 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 as changed. + (setcar (cdr lexvar) t)) ; Mark variable to be kept. (push var var-expr-list) (push value var-expr-list)) (setq args (cddr args))) @@ -735,8 +739,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (let* ((opt-body (byte-optimize-body (cdr form) for-effect)) (bindings nil)) (dolist (var let-vars) - ;; VAR is (NAME EXPR [CHANGED [VALUE]]) + ;; VAR is (NAME EXPR [KEEP [VALUE]]) (if (and (nthcdr 3 var) (not (nth 2 var))) + ;; Value present and not marked to be kept: eliminate. (when byte-optimize-warn-eliminated-variable (byte-compile-warn "eliminating local variable %S" (car var))) (push (list (nth 0 var) (nth 1 var)) bindings))) -- cgit v1.2.3 From 7e48430a43bbf7a2bbe347540dc346d0129df2ec Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 7 Feb 2021 12:24:40 +0100 Subject: ; * lisp/emacs-lisp/byte-opt.el: improved comment --- lisp/emacs-lisp/byte-opt.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 32f66ebebb9..abbe2a2e63f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -440,7 +440,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (let ((lexvar (assq form byte-optimize--lexvars))) (if (cddr lexvar) ; Value available? (if (assq form byte-optimize--vars-outside-loop) - ;; Cannot substitute; mark as changed to avoid the + ;; Cannot substitute; mark for retention to avoid the ;; variable being eliminated. (progn (setcar (cdr lexvar) t) -- cgit v1.2.3 From 04fb1664a8ee3c20ed8a231ce5c9bb05a145f8e0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Feb 2021 12:02:25 -0500 Subject: * lisp/emacs-lisp/macroexp.el: Break cycle with bytecomp/byte-opt The recent change in macroexp triggered a cyclic dependency error during eager macroexpansion when neither `bytecomp` nor `byte-opt` had been byte-compiled yet. This fixes it by moving the offending function to macroexp.el. * lisp/emacs-lisp/macroexp.el (macroexp--unfold-lambda): Move from byte-opt.el and rename. (macroexp--expand-all): Use it. * lisp/emacs-lisp/byte-opt.el (byte-compile-unfold-lambda): Move to macroexp.el. (byte-compile-inline-expand, byte-optimize-form-code-walker): * lisp/emacs-lisp/bytecomp.el (byte-compile-form): Use `macroexp--unfold-lambda` instead. --- lisp/emacs-lisp/byte-opt.el | 72 ++------------------------------------------- lisp/emacs-lisp/bytecomp.el | 3 +- lisp/emacs-lisp/macroexp.el | 71 ++++++++++++++++++++++++++++++++++++++++---- 3 files changed, 68 insertions(+), 78 deletions(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index abbe2a2e63f..e67077639c2 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -289,7 +289,7 @@ (byte-compile-preprocess (byte-compile--reify-function fn)))))) (if (eq (car-safe newfn) 'function) - (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + (macroexp--unfold-lambda `(,(cadr newfn) ,@(cdr form))) ;; This can happen because of macroexp-warn-and-return &co. (byte-compile-warn "Inlining closure %S failed" name) @@ -297,74 +297,6 @@ (_ ;; Give up on inlining. form)))) - -;; ((lambda ...) ...) -(defun byte-compile-unfold-lambda (form &optional name) - ;; In lexical-binding mode, let and functions don't bind vars in the same way - ;; (let obey special-variable-p, but functions don't). But luckily, this - ;; doesn't matter here, because function's behavior is underspecified so it - ;; can safely be turned into a `let', even though the reverse is not true. - (or name (setq name "anonymous lambda")) - (let* ((lambda (car form)) - (values (cdr form)) - (arglist (nth 1 lambda)) - (body (cdr (cdr lambda))) - optionalp restp - bindings) - (if (and (stringp (car body)) (cdr body)) - (setq body (cdr body))) - (if (and (consp (car body)) (eq 'interactive (car (car body)))) - (setq body (cdr body))) - ;; FIXME: The checks below do not belong in an optimization phase. - (while arglist - (cond ((eq (car arglist) '&optional) - ;; ok, I'll let this slide because funcall_lambda() does... - ;; (if optionalp (error "multiple &optional keywords in %s" name)) - (if restp (error "&optional found after &rest in %s" name)) - (if (null (cdr arglist)) - (error "nothing after &optional in %s" name)) - (setq optionalp t)) - ((eq (car arglist) '&rest) - ;; ...but it is by no stretch of the imagination a reasonable - ;; thing that funcall_lambda() allows (&rest x y) and - ;; (&rest x &optional y) in arglists. - (if (null (cdr arglist)) - (error "nothing after &rest in %s" name)) - (if (cdr (cdr arglist)) - (error "multiple vars after &rest in %s" name)) - (setq restp t)) - (restp - (setq bindings (cons (list (car arglist) - (and values (cons 'list values))) - bindings) - values nil)) - ((and (not optionalp) (null values)) - (byte-compile-warn "attempt to open-code `%s' with too few arguments" name) - (setq arglist nil values 'too-few)) - (t - (setq bindings (cons (list (car arglist) (car values)) - bindings) - values (cdr values)))) - (setq arglist (cdr arglist))) - (if values - (progn - (or (eq values 'too-few) - (byte-compile-warn - "attempt to open-code `%s' with too many arguments" name)) - form) - - ;; The following leads to infinite recursion when loading a - ;; file containing `(defsubst f () (f))', and then trying to - ;; byte-compile that file. - ;(setq body (mapcar 'byte-optimize-form body))) - - (let ((newform - (if bindings - (cons 'let (cons (nreverse bindings) body)) - (cons 'progn body)))) - (byte-compile-log " %s\t==>\t%s" form newform) - newform)))) - ;;; implementing source-level optimizers @@ -604,7 +536,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") form) (`((lambda . ,_) . ,_) - (let ((newform (byte-compile-unfold-lambda form))) + (let ((newform (macroexp--unfold-lambda form))) (if (eq newform form) ;; Some error occurred, avoid infinite recursion. form diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 9429d6a0d5d..89068a14f02 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -195,7 +195,6 @@ otherwise adds \".elc\"." (autoload 'byte-optimize-form "byte-opt") ;; This is the entry point to the lapcode optimizer pass2. (autoload 'byte-optimize-lapcode "byte-opt") -(autoload 'byte-compile-unfold-lambda "byte-opt") ;; This is the entry point to the decompiler, which is used by the ;; disassembler. The disassembler just requires 'byte-compile, but @@ -3277,7 +3276,7 @@ for symbols generated by the byte compiler itself." ((and (eq (car-safe (car form)) 'lambda) ;; if the form comes out the same way it went in, that's ;; because it was malformed, and we couldn't unfold it. - (not (eq form (setq form (byte-compile-unfold-lambda form))))) + (not (eq form (setq form (macroexp--unfold-lambda form))))) (byte-compile-form form byte-compile--for-effect) (setq byte-compile--for-effect nil)) ((byte-compile-normal-call form))) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e842222b7c3..042061c44fc 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -200,6 +200,69 @@ and also to avoid outputting the warning during normal execution." new-form)) new-form))) +(defun macroexp--unfold-lambda (form &optional name) + ;; In lexical-binding mode, let and functions don't bind vars in the same way + ;; (let obey special-variable-p, but functions don't). But luckily, this + ;; doesn't matter here, because function's behavior is underspecified so it + ;; can safely be turned into a `let', even though the reverse is not true. + (or name (setq name "anonymous lambda")) + (let* ((lambda (car form)) + (values (cdr form)) + (arglist (nth 1 lambda)) + (body (cdr (cdr lambda))) + optionalp restp + bindings) + (if (and (stringp (car body)) (cdr body)) + (setq body (cdr body))) + (if (and (consp (car body)) (eq 'interactive (car (car body)))) + (setq body (cdr body))) + ;; FIXME: The checks below do not belong in an optimization phase. + (while arglist + (cond ((eq (car arglist) '&optional) + ;; ok, I'll let this slide because funcall_lambda() does... + ;; (if optionalp (error "multiple &optional keywords in %s" name)) + (if restp (error "&optional found after &rest in %s" name)) + (if (null (cdr arglist)) + (error "nothing after &optional in %s" name)) + (setq optionalp t)) + ((eq (car arglist) '&rest) + ;; ...but it is by no stretch of the imagination a reasonable + ;; thing that funcall_lambda() allows (&rest x y) and + ;; (&rest x &optional y) in arglists. + (if (null (cdr arglist)) + (error "nothing after &rest in %s" name)) + (if (cdr (cdr arglist)) + (error "multiple vars after &rest in %s" name)) + (setq restp t)) + (restp + (setq bindings (cons (list (car arglist) + (and values (cons 'list values))) + bindings) + values nil)) + ((and (not optionalp) (null values)) + (setq arglist nil values 'too-few)) + (t + (setq bindings (cons (list (car arglist) (car values)) + bindings) + values (cdr values)))) + (setq arglist (cdr arglist))) + (if values + (macroexp--warn-and-return + (format (if (eq values 'too-few) + "attempt to open-code `%s' with too few arguments" + "attempt to open-code `%s' with too many arguments") + name) + form) + + ;; The following leads to infinite recursion when loading a + ;; file containing `(defsubst f () (f))', and then trying to + ;; byte-compile that file. + ;;(setq body (mapcar 'byte-optimize-form body))) + + (if bindings + `(let ,(nreverse bindings) . ,body) + (macroexp-progn body))))) + (defun macroexp--expand-all (form) "Expand all macros in FORM. This is an internal version of `macroexpand-all'. @@ -245,12 +308,8 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; i.e. rewrite it to (let () ). We'd do it in the optimizer ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the ;; creation of a closure, thus resulting in much better code. - (let ((newform (if (not (fboundp 'byte-compile-unfold-lambda)) - 'macroexp--not-unfolded - ;; Don't unfold if byte-opt is not yet loaded. - (byte-compile-unfold-lambda form)))) - (if (or (eq newform 'macroexp--not-unfolded) - (eq newform form)) + (let ((newform (macroexp--unfold-lambda form))) + (if (eq newform form) ;; Unfolding failed for some reason, avoid infinite recursion. (macroexp--cons (macroexp--all-forms fun 2) (macroexp--all-forms args) -- cgit v1.2.3 From 6fd8548b1620aadd2c9e4efddd899b87d023913b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Feb 2021 12:10:07 -0500 Subject: * lisp/emacs-lisp/byte-opt.el (byte-optimize--pcase): New macro (byte-optimize-form-code-walker): Use it. --- lisp/emacs-lisp/byte-opt.el | 70 ++++++++++++++++++++++++++++++++------------- 1 file changed, 50 insertions(+), 20 deletions(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index e67077639c2..4fa2c75a889 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -348,6 +348,40 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (symbolp (cadr expr))) (keywordp expr))) +(defmacro byte-optimize--pcase (exp &rest cases) + ;; When we do + ;; + ;; (pcase EXP + ;; (`(if ,exp ,then ,else) (DO-TEST)) + ;; (`(plus ,e2 ,e2) (DO-ADD)) + ;; (`(times ,e2 ,e2) (DO-MULT)) + ;; ...) + ;; + ;; we usually don't want to fall back to the default case if + ;; the value of EXP is of a form like `(if E1 E2)' or `(plus E1)' + ;; or `(times E1 E2 E3)', instead we either want to signal an error + ;; that EXP has an unexpected shape, or we want to carry on as if + ;; it had the right shape (ignore the extra data and pretend the missing + ;; data is nil) because it should simply never happen. + ;; + ;; The macro below implements the second option by rewriting patterns + ;; like `(if ,exp ,then ,else)' + ;; to `(if . (or `(,exp ,then ,else) pcase--dontcare))'. + ;; + ;; The resulting macroexpansion is also significantly cleaner/smaller/faster. + (declare (indent 1) (debug (form &rest (pcase-PAT body)))) + `(pcase ,exp + . ,(mapcar (lambda (case) + `(,(pcase (car case) + ((and `(,'\` (,_ . (,'\, ,_))) pat) pat) + (`(,'\` (,head . ,tail)) + (list '\` + (cons head + (list '\, `(or ,(list '\` tail) pcase--dontcare))))) + (pat pat)) + . ,(cdr case))) + cases))) + (defun byte-optimize-form-code-walker (form for-effect) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But @@ -360,7 +394,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; have no place in an optimizer: the corresponding tests should be ;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'. (let ((fn (car-safe form))) - (pcase form + (byte-optimize--pcase form ((pred (not consp)) (cond ((and for-effect @@ -370,7 +404,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") nil) ((symbolp form) (let ((lexvar (assq form byte-optimize--lexvars))) - (if (cddr lexvar) ; Value available? + (if (cddr lexvar) ; Value available? (if (assq form byte-optimize--vars-outside-loop) ;; Cannot substitute; mark for retention to avoid the ;; variable being eliminated. @@ -390,27 +424,27 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (not for-effect) form)) (`(,(or 'let 'let*) . ,rest) - (cons fn (byte-optimize-let-form fn rest for-effect))) + (cons fn (byte-optimize-let-form fn rest for-effect))) (`(cond . ,clauses) ;; The condition in the first clause is always executed, but ;; right now we treat all of them as conditional for simplicity. (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) (cons fn (mapcar (lambda (clause) - (if (consp clause) - (cons - (byte-optimize-form (car clause) nil) - (byte-optimize-body (cdr clause) for-effect)) - (byte-compile-warn "malformed cond form: `%s'" - (prin1-to-string clause)) - clause)) - clauses)))) + (if (consp clause) + (cons + (byte-optimize-form (car clause) nil) + (byte-optimize-body (cdr clause) for-effect)) + (byte-compile-warn "malformed cond form: `%s'" + (prin1-to-string clause)) + clause)) + clauses)))) (`(progn . ,exps) ;; As an extra added bonus, this simplifies (progn ) --> . (if (cdr exps) (macroexp-progn (byte-optimize-body exps for-effect)) (byte-optimize-form (car exps) for-effect))) - (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare)) + (`(prog1 ,exp . ,exps) (if exps `(prog1 ,(byte-optimize-form exp for-effect) . ,(byte-optimize-body exps t)) @@ -435,8 +469,6 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (then-opt (byte-optimize-form then for-effect)) (else-opt (byte-optimize-body else for-effect))) `(if ,test-opt ,then-opt . ,else-opt))) - (`(if . ,_) - (byte-compile-warn "too few arguments for `if'")) (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. ;; FIXME: We have to traverse the expressions in left-to-right @@ -474,8 +506,6 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (body (byte-optimize-body exps t))) `(while ,condition . ,body))) - (`(while . ,_) - (byte-compile-warn "too few arguments for `while'")) (`(interactive . ,_) (byte-compile-warn "misplaced interactive spec: `%s'" @@ -487,9 +517,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; all the subexpressions and compiling them separately. form) - (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare)) + (`(condition-case ,var ,exp . ,clauses) (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) - `(condition-case ,var ;Not evaluated. + `(condition-case ,var ;Not evaluated. ,(byte-optimize-form exp for-effect) ,@(mapcar (lambda (clause) `(,(car clause) @@ -513,7 +543,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") `(unwind-protect ,bodyform . ,(byte-optimize-body exps t)))))) - (`(catch . ,(or `(,tag . ,exps) pcase--dontcare)) + (`(catch ,tag . ,exps) (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) `(catch ,(byte-optimize-form tag nil) . ,(byte-optimize-body exps for-effect)))) @@ -566,7 +596,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (setcdr (cdr lexvar) (and (byte-optimize--substitutable-p value) (list value)))) - (setcar (cdr lexvar) t)) ; Mark variable to be kept. + (setcar (cdr lexvar) t)) ; Mark variable to be kept. (push var var-expr-list) (push value var-expr-list)) (setq args (cddr args))) -- cgit v1.2.3 From f3ae26cb2ae581a84bbaa15a47e9917a799a5682 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 10 Feb 2021 14:26:49 +0100 Subject: Fix local defvar scoping error (bug#46387) This bug was introduced by the lexical variable constant propagation mechanism. It was discovered by Michael Heerdegen. * lisp/emacs-lisp/byte-opt.el (byte-optimize-let-form) (byte-optimize-body): Let the effects of a local defvar declaration be scoped by let and let*, not any arbitrary Lisp expression body (such as progn). * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--get-vars) (bytecomp-local-defvar): New test. --- lisp/emacs-lisp/byte-opt.el | 4 ++-- test/lisp/emacs-lisp/bytecomp-tests.el | 31 +++++++++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4fa2c75a889..8851f0ef32d 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -698,7 +698,8 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (append new-lexvars byte-optimize--lexvars)) ;; Walk the body expressions, which may mutate some of the records, ;; and generate new bindings that exclude unused variables. - (let* ((opt-body (byte-optimize-body (cdr form) for-effect)) + (let* ((byte-optimize--dynamic-vars byte-optimize--dynamic-vars) + (opt-body (byte-optimize-body (cdr form) for-effect)) (bindings nil)) (dolist (var let-vars) ;; VAR is (NAME EXPR [KEEP [VALUE]]) @@ -730,7 +731,6 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") ;; all-for-effect is true. returns a new list of forms. (let ((rest forms) (result nil) - (byte-optimize--dynamic-vars byte-optimize--dynamic-vars) fe new) (while rest (setq fe (or all-for-effect (cdr rest))) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index bc623d3efca..0b70c11b298 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1168,6 +1168,37 @@ mountpoint (Bug#44631)." (with-demoted-errors "Error cleaning up directory: %s" (delete-directory directory :recursive))))) +(defun bytecomp-tests--get-vars () + (list (ignore-errors (symbol-value 'bytecomp-tests--var1)) + (ignore-errors (symbol-value 'bytecomp-tests--var2)))) + +(ert-deftest bytecomp-local-defvar () + "Check that local `defvar' declarations work correctly, both +interpreted and compiled." + (let ((lexical-binding t)) + (let ((fun '(lambda () + (defvar bytecomp-tests--var1) + (let ((bytecomp-tests--var1 'a) ; dynamic + (bytecomp-tests--var2 'b)) ; still lexical + (ignore bytecomp-tests--var2) ; avoid warning + (bytecomp-tests--get-vars))))) + (should (listp fun)) ; Guard against overzealous refactoring! + (should (equal (funcall (eval fun t)) '(a nil))) + (should (equal (funcall (byte-compile fun)) '(a nil))) + ) + + ;; `progn' does not constitute a lexical scope for `defvar' (bug#46387). + (let ((fun '(lambda () + (progn + (defvar bytecomp-tests--var1) + (defvar bytecomp-tests--var2)) + (let ((bytecomp-tests--var1 'c) + (bytecomp-tests--var2 'd)) + (bytecomp-tests--get-vars))))) + (should (listp fun)) + (should (equal (funcall (eval fun t)) '(c d))) + (should (equal (funcall (byte-compile fun)) '(c d)))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: -- cgit v1.2.3