From 7969e41654b2b5c628c290deb938699a95e85fec Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 18 May 2022 09:18:15 +0000 Subject: [PATCH] Fix M-x compile-defun when an interactive form is (list ...) This is for when lexical-binding is nil. The problem fixed was M-x compile-defun leaving symbols with position in the compiled function's arglist and interactive form. This fixes bug #55323. Also ensure the doc string is correctly stripped when lexical-binding is t. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): For a (list ...) interactive form when lexical-binding is nil, strip the positions from the symbols in the form. Also strip the position from the symbols in the arglist. (byte-compile-make-closure): (Twice) strip symbols from positions in the doc string expression. Add comments. --- lisp/emacs-lisp/bytecomp.el | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1fef9b00d85..e72b96af4a9 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3114,7 +3114,8 @@ lambda-expression." ;; which may include "calls" to ;; internal-make-closure (Bug#29988). lexical-binding) - (setq int `(,(car int) ,newform))))) + (setq int `(,(car int) ,newform)) + (setq int (byte-run-strip-symbol-positions int))))) ; for compile-defun. ((cdr int) ; Invalid (interactive . something). (byte-compile-warn-x int "malformed interactive spec: %s" int)))) @@ -3129,7 +3130,7 @@ lambda-expression." (byte-compile-make-lambda-lexenv arglistvars)) reserved-csts)) - (bare-arglist arglist)) + (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun. ;; Build the actual byte-coded function. (cl-assert (eq 'byte-code (car-safe compiled))) (let ((out @@ -3951,7 +3952,9 @@ discarding." (byte-defop-compiler-1 internal-get-closed-var byte-compile-get-closed-var) (defun byte-compile-make-closure (form) - "Byte-compile the special `internal-make-closure' form." + "Byte-compile the special `internal-make-closure' form. + +This function is never called when `lexical-binding' is nil." (if byte-compile--for-effect (setq byte-compile--for-effect nil) (let* ((vars (nth 1 form)) (env (nth 2 form)) @@ -3973,24 +3976,33 @@ discarding." (number-sequence 4 (1- (length fun))))) (proto-fun (apply #'make-byte-code - (aref fun 0) (aref fun 1) + (aref fun 0) ; The arglist is always the 15-bit + ; form, never the list of symbols. + (aref fun 1) ; The byte-code. ;; Prepend dummy cells to the constant vector, ;; to get the indices right when disassembling. (vconcat dummy-vars (aref fun 2)) - (aref fun 3) + (aref fun 3) ; Stack depth of function (if docstring-exp - (cons (eval docstring-exp t) (cdr opt-args)) + (cons + (eval (byte-run-strip-symbol-positions + docstring-exp) + t) + (cdr opt-args)) ; The interactive spec will + ; have been stripped in + ; `byte-compile-lambda'. opt-args)))) `(make-closure ,proto-fun ,@env)) ;; Nontrivial doc string expression: create a bytecode object ;; from small pieces at run time. `(make-byte-code - ',(aref fun 0) ',(aref fun 1) - (vconcat (vector . ,env) ',(aref fun 2)) + ',(aref fun 0) ; 15-bit form of arglist descriptor. + ',(aref fun 1) ; The byte-code. + (vconcat (vector . ,env) ',(aref fun 2)) ; constant vector. ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) (if docstring-exp `(,(car rest) - ,docstring-exp + ,(byte-run-strip-symbol-positions docstring-exp) ,@(cddr rest)) rest)))) )))) -- 2.39.2