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."