mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-30 09:00:31 -08:00
Code Issues Projects Releases Wiki Activity

Fix M-x compile-defun when an interactive form is (list ...)

Browse source 
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.
This commit is contained in:
Alan Mackenzie 2022-05-18 09:18:15 +00:00
parent e1c972b247
commit 7969e41654
1 changed files with 21 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

30
lisp/emacs-lisp/bytecomp.el
View file

@ -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))))
))))