Fix compilation of closures with nontrivial doc strings

* lisp/emacs-lisp/bytecomp.el (byte-compile-make-closure):
Use the supplied doc string if it's a literal; fall back to the old
slow way of building a closure otherwise.
This commit is contained in:
Mattias Engdegård 2021-02-22 11:37:29 +01:00
parent 0fb6f05bcb
commit 88a02e4c89

View file

@ -3818,20 +3818,37 @@ discarding."
docstring-exp)) ;Otherwise, we don't need a closure.
(cl-assert (byte-code-function-p fun))
(byte-compile-form
;; Use symbols V0, V1 ... as placeholders for closure variables:
;; they should be short (to save space in the .elc file), yet
;; distinct when disassembled.
(let* ((dummy-vars (mapcar (lambda (i) (intern (format "V%d" i)))
(number-sequence 0 (1- (length env)))))
(proto-fun
(apply #'make-byte-code
(aref fun 0) (aref fun 1)
;; Prepend dummy cells to the constant vector,
;; to get the indices right when disassembling.
(vconcat dummy-vars (aref fun 2))
(mapcar (lambda (i) (aref fun i))
(number-sequence 3 (1- (length fun)))))))
`(make-closure ,proto-fun ,@env))))))
(if (or (not docstring-exp) (stringp docstring-exp))
;; Use symbols V0, V1 ... as placeholders for closure variables:
;; they should be short (to save space in the .elc file), yet
;; distinct when disassembled.
(let* ((dummy-vars (mapcar (lambda (i) (intern (format "V%d" i)))
(number-sequence 0 (1- (length env)))))
(opt-args (mapcar (lambda (i) (aref fun i))
(number-sequence 4 (1- (length fun)))))
(proto-fun
(apply #'make-byte-code
(aref fun 0) (aref fun 1)
;; Prepend dummy cells to the constant vector,
;; to get the indices right when disassembling.
(vconcat dummy-vars (aref fun 2))
(aref fun 3)
(if docstring-exp
(cons docstring-exp (cdr opt-args))
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))
,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
(if docstring-exp
`(,(car rest)
,docstring-exp
,@(cddr rest))
rest))))
))))
(defun byte-compile-get-closed-var (form)
"Byte-compile the special `internal-get-closed-var' form."