Function: byte-compile-lambda
byte-compile-lambda is a byte-compiled function defined in
bytecomp.el.gz.
Signature
(byte-compile-lambda FUN &optional RESERVED-CSTS)
Documentation
Byte-compile a lambda-expression and return a valid function.
The value is usually a compiled function but may be the original lambda-expression.
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/bytecomp.el.gz
(defun byte-compile-lambda (fun &optional reserved-csts)
"Byte-compile a lambda-expression and return a valid function.
The value is usually a compiled function but may be the original
lambda-expression."
(unless (eq 'lambda (car-safe fun))
(error "Not a lambda list: %S" fun))
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(bare-arglist (byte-run-strip-symbol-positions arglist)) ; for compile-defun.
(arglistvars (byte-run-strip-symbol-positions
(byte-compile-arglist-vars arglist)))
(byte-compile-bound-variables
(append (if (not lexical-binding) arglistvars)
byte-compile-bound-variables))
(body (cdr (cdr fun)))
;; Treat a final string literal as a value, not a doc string.
(doc (if (and (cdr body) (stringp (car body)))
(prog1 (car body)
;; Discard the doc string from the body.
(setq body (cdr body)))))
(int (assq 'interactive body))
command-modes)
(when lexical-binding
(when arglist
;; byte-compile-make-args-desc lost the args's names,
;; so preserve them in the docstring.
(setq doc (help-add-fundoc-usage doc bare-arglist)))
(dolist (var arglistvars)
(when (assq var byte-compile--known-dynamic-vars)
(byte-compile--warn-lexical-dynamic var 'lambda))))
(when (stringp doc)
(setq doc (byte-compile--docstring doc "" nil 'is-a-value)))
;; Process the interactive spec.
(when int
;; Skip (interactive) if it is in front (the most usual location).
(if (eq int (car body))
(setq body (cdr body)))
(cond ((consp (cdr int)) ; There is an `interactive' spec.
;; Check that the bit after the `interactive' spec is
;; just a list of symbols (i.e., modes).
(unless (seq-every-p #'symbolp (cdr (cdr int)))
(byte-compile-warn-x
int "malformed `interactive' specification: %s" int))
(setq command-modes (cdr (cdr int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
;; args of `list'. Actually, compile it to get warnings,
;; but don't use the result.
(let* ((form (nth 1 int))
(newform (byte-compile-top-level form)))
(while (memq (car-safe form) '(let let* progn save-excursion))
(while (consp (cdr form))
(setq form (cdr form)))
(setq form (car form)))
(if (or (not (eq (car-safe form) 'list))
;; For code using lexical-binding, form is not
;; valid lisp, but rather an intermediate form
;; which may include "calls" to
;; internal-make-closure (Bug#29988).
lexical-binding)
(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))))
;; Process the body.
(let ((compiled
(byte-compile-top-level (cons 'progn body) nil 'lambda
;; If doing lexical binding, push a new
;; lexical environment containing just the
;; args (since lambda expressions should be
;; closed by now).
(and lexical-binding
(byte-compile-make-lambda-lexenv
arglistvars))
reserved-csts)))
;; Build the actual byte-coded function.
(cl-assert (eq 'byte-code (car-safe compiled)))
(let ((out
(apply #'make-byte-code
(if lexical-binding
(byte-compile-make-args-desc arglist)
bare-arglist)
;; code string, deduplicated
(let* ((code (cadr compiled))
(prev (member code bytecomp--code-strings)))
(if prev
(car prev)
(push code bytecomp--code-strings)
code))
(append
;; constants-vector and stack depth
(drop 2 compiled)
;; optionally, the doc string.
(when (or doc int) (list doc))
;; optionally, the interactive spec (and the modes the
;; command applies to).
(cond
;; We have some command modes, so use the vector form.
(command-modes
(list (vector (nth 1 int) command-modes)))
;; No command modes, use the simple form with just the
;; interactive spec.
(int
(list (nth 1 int))))))))
(when byte-native-compiling
(setf (byte-to-native-lambda-byte-func
(gethash (cadr compiled)
byte-to-native-lambdas-h))
out))
out))))