mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-23 18:47:57 +00:00
Code Issues Releases Activity

Use a dedicated type to represent interpreted-function values

Browse Source 
Change `function` so that when evaluating #'(lambda ...)
we return an object of type `interpreted-function` rather than
a list starting with one of `lambda` or `closure`.
The new type reuses the existing PVEC_CLOSURE (nee PVEC_COMPILED)
tag and tries to align the corresponding elements:

- the arglist, the docstring, and the interactive-form go in the
  same slots as for byte-code functions.
- the body of the function goes in the slot used for the bytecode string.
- the lexical context goes in the slot used for the constants of
  bytecoded functions.

The first point above means that `help-function-arglist`,
`documentation`, and `interactive-form`s don't need to
distinguish interpreted and bytecode functions any more.

Main benefits of the change:

- We can now reliably distinguish a list from a function value.
- `cl-defmethod` can dispatch on `interactive-function` and `closure`.
  Dispatch on `function` also works now for interpreted functions but still
  won't work for functions represented as lists or as symbols, of course.
- Function values are now self-evaluating.  That was alrready the case
  when byte-compiled, but not when interpreted since
  (eval '(closure ...)) signals a void-function error.
  That also avoids false-positive warnings about "don't quote your lambdas"
  when doing things like `(mapcar ',func ...)`.

* src/eval.c (Fmake_interpreted_closure): New function.
(Ffunction): Use it and change calling convention of
`Vinternal_make_interpreted_closure_function`.
(FUNCTIONP, Fcommandp, eval_sub, funcall_general, funcall_lambda)
(Ffunc_arity, lambda_arity): Simplify.
(funcall_lambda): Adjust to new representation.
(syms_of_eval): `defsubr` the new function.  Remove definition of `Qclosure`.

* lisp/emacs-lisp/cconv.el (cconv-make-interpreted-closure):
Change calling convention and use `make-interpreted-closure`.

* src/data.c (Fcl_type_of): Distinguish `byte-code-function`s from
`interpreted-function`s.
(Fclosurep, finterpreted_function_p): New functions.
(Fbyte_code_function_p): Don't be confused by `interpreted-function`s.
(Finteractive_form, Fcommand_modes): Simplify.
(syms_of_data): Define new type symbols and `defsubr` the two
new functions.

* lisp/emacs-lisp/cl-print.el (cl-print-object) <interpreted-function>:
New method.

* lisp/emacs-lisp/oclosure.el (oclosure): Refine the parent
to be `closure`.
(oclosure--fix-type, oclosure-type): Simplify.
(oclosure--copy, oclosure--get, oclosure--set): Adjust to
new representation.

* src/callint.c (Fcall_interactively): Adjust to new representation.

* src/lread.c (bytecode_from_rev_list):

* lisp/simple.el (function-documentation):
* lisp/help.el (help-function-arglist): Remove the old `closure` case
and adjust the byte-code case so it handles `interpreted-function`s.

* lisp/emacs-lisp/cl-preloaded.el (closure): New type.
(byte-code-function): Add it as a parent.
(interpreted-function): Adjust parent (the type itself was already
added earlier by accident).

* lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Adjust to
new representation.
(byte-compile): Use `interpreted-function-p`.

* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Adjust to
new representation.
(side-effect-free-fns): Add `interpreted-function-p` and `closurep`.

* src/profiler.c (trace_hash, ffunction_equal): Simplify.
* lisp/profiler.el (profiler-function-equal): Simplify.

* lisp/emacs-lisp/nadvice.el (advice--interactive-form-1):
Use `interpreted-function-p`; adjust to new representation; and take
advantage of the fact that function values are now self-evaluating.

* lisp/emacs-lisp/lisp-mode.el (closure):
Remove `lisp-indent-function` property.

* lisp/emacs-lisp/disass.el (disassemble-internal): Adjust to
new representation.
* lisp/emacs-lisp/edebug.el (edebug--strip-instrumentation):
Use `interpreted-function-p`.
* lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers):
Add `closurep` and `interpreted-function-p`.

* test/lisp/help-fns-tests.el (help-fns-test-lisp-defun): Adjust to
more precise type info in `describe-function`.
* test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d--render-entries):
Use `interpreted-function-p`.
* test/lisp/emacs-lisp/macroexp-resources/vk.el (vk-f4, vk-f5):
Don't hardcode function values.

* doc/lispref/functions.texi (Anonymous Functions): Don't suggest that
function values are lists.  Reword "self-quoting" to reflect the
fact that #' doesn't return the exact same object.  Update examples
with the new shape of the return value.

* doc/lispref/variables.texi (Lexical Binding):
* doc/lispref/lists.texi (Rearrangement):
* doc/lispref/control.texi (Handling Errors): Update examples to reflect
new representation of function values.
This commit is contained in:
Stefan Monnier 2024-03-11 16:12:26 -04:00
parent 2fa839c188
commit f2bccae22b
31 changed files with 435 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
doc/lispref/compile.texi
View File

@ -37,7 +37,7 @@ variable binding for @code{no-byte-compile} into it, like this:
* Docs and Compilation:: Dynamic loading of documentation strings.
* Eval During Compile:: Code to be evaluated when you compile.
* Compiler Errors:: Handling compiler error messages.
* Byte-Code Objects:: The data type used for byte-compiled functions.
* Closure Objects:: The data type used for byte-compiled functions.
* Disassembly:: Disassembling byte-code; how to read byte-code.
@end menu
@ -120,7 +120,7 @@ replacing the previous definition with the compiled one. The function
definition of @var{symbol} must be the actual code for the function;
@code{byte-compile} does not handle function indirection. The return
value is the byte-code function object which is the compiled
definition of @var{symbol} (@pxref{Byte-Code Objects}).
definition of @var{symbol} (@pxref{Closure Objects}).
@example
@group
@ -487,21 +487,22 @@ string for details.
using @code{error}. If so, set @code{byte-compile-error-on-warn} to a
non-@code{nil} value.
@node Byte-Code Objects
@section Byte-Code Function Objects
@node Closure Objects
@section Closure Function Objects
@cindex compiled function
@cindex byte-code function
@cindex byte-code object
Byte-compiled functions have a special data type: they are
@dfn{byte-code function objects}. Whenever such an object appears as
a function to be called, Emacs uses the byte-code interpreter to
execute the byte-code.
Byte-compiled functions use a special data type: they are closures.
Closures are used both for byte-compiled Lisp functions as well as for
interpreted Lisp functions. Whenever such an object appears as
a function to be called, Emacs uses the appropriate interpreter to
execute either the byte-code or the non-compiled Lisp code.
Internally, a byte-code function object is much like a vector; its
Internally, a closure is much like a vector; its
elements can be accessed using @code{aref}. Its printed
representation is like that for a vector, with an additional @samp{#}
before the opening @samp{[}. It must have at least four elements;
before the opening @samp{[}. It must have at least three elements;
there is no maximum number, but only the first six elements have any
normal use. They are:
@ -515,20 +516,28 @@ zero to 6, and the maximum number of arguments in bits 8 to 14. If
the argument list uses @code{&rest}, then bit 7 is set; otherwise it's
cleared.
If @var{argdesc} is a list, the arguments will be dynamically bound
When the closure is a byte-code function,
if @var{argdesc} is a list, the arguments will be dynamically bound
before executing the byte code. If @var{argdesc} is an integer, the
arguments will be instead pushed onto the stack of the byte-code
interpreter, before executing the code.
@item byte-code
The string containing the byte-code instructions.
@item code
For interpreted functions, this element is the (non-empty) list of Lisp
forms that make up the function's body. For byte-compiled functions, it
is the string containing the byte-code instructions.
@item constants
The vector of Lisp objects referenced by the byte code. These include
symbols used as function names and variable names.
For byte-compiled functions, this holds the vector of Lisp objects
referenced by the byte code. These include symbols used as function
names and variable names.
For interpreted functions, this is @code{nil} if the function is using the old
dynamically scoped dialect of Emacs Lisp, and otherwise it holds the
function's lexical environment.
@item stacksize
The maximum stack size this function needs.
The maximum stack size this function needs. This element is left unused
for interpreted functions.
@item docstring
The documentation string (if any); otherwise, @code{nil}. The value may
@ -558,8 +567,8 @@ representation. It is the definition of the command
@code{make-byte-code}:
@defun make-byte-code &rest elements
This function constructs and returns a byte-code function object
with @var{elements} as its elements.
This function constructs and returns a closure which represents the
byte-code function object with @var{elements} as its elements.
@end defun
You should not try to come up with the elements for a byte-code
@ -567,6 +576,20 @@ function yourself, because if they are inconsistent, Emacs may crash
when you call the function. Always leave it to the byte compiler to
create these objects; it makes the elements consistent (we hope).
The primitive way to create an interpreted function is with
@code{make-interpreted-closure}:
@defun make-interpreted-closure args body env &optional docstring iform
This function constructs and returns a closure representing the
interpreted function with arguments @var{args} and whose body is made of
@var{body} which must be a non-@code{nil} list of Lisp forms. @var{env} is the
lexical environment in the same form as used with @code{eval}
(@pxref{Eval}). The documentation @var{docstring} if non-@code{nil} should be
a string, and the interactive form @var{iform} if non-@code{nil} should be of
the form @w{@code{(interactive @var{arg-descriptor})}} (@pxref{Using
Interactive}).
@end defun
@node Disassembly
@section Disassembled Byte-Code
@cindex disassembled byte-code
@ -595,7 +618,7 @@ name of an existing buffer. Then the output goes there, at point, and
point is left before the output.
The argument @var{object} can be a function name, a lambda expression
(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Byte-Code
(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Closure
Objects}). If it is a lambda expression, @code{disassemble} compiles
it and disassembles the resulting compiled code.
@end deffn

2
doc/lispref/control.texi
View File

@ -2412,7 +2412,7 @@ point where we signaled the original error:
@group
Debugger entered--Lisp error: (error "Oops")
signal(error ("Oops"))
(closure (t) (err) (signal 'error (cdr err)))((user-error "Oops"))
#f(lambda (err) [t] (signal 'error (cdr err)))((user-error "Oops"))
user-error("Oops")
@dots{}
eval((handler-bind ((user-error (lambda (err) @dots{}

4
doc/lispref/elisp.texi
View File

@ -323,7 +323,7 @@ Programming Types
* Macro Type:: A method of expanding an expression into another
expression, more fundamental but less pretty.
* Primitive Function Type:: A function written in C, callable from Lisp.
* Byte-Code Type:: A function written in Lisp, then compiled.
* Closure Type:: A function written in Lisp, then compiled.
* Record Type:: Compound objects with programmer-defined types.
* Type Descriptors:: Objects holding information about types.
* Autoload Type:: A type used for automatically loading seldom-used
@ -657,7 +657,7 @@ Byte Compilation
* Docs and Compilation:: Dynamic loading of documentation strings.
* Eval During Compile:: Code to be evaluated when you compile.
* Compiler Errors:: Handling compiler error messages.
* Byte-Code Objects:: The data type used for byte-compiled functions.
* Closure Objects:: The data type used for byte-compiled functions.
* Disassembly:: Disassembling byte-code; how to read byte-code.
Native Compilation

36
doc/lispref/functions.texi
View File

@ -130,7 +130,7 @@ it also encloses an environment of lexical variable bindings.
@item byte-code function
A function that has been compiled by the byte compiler.
@xref{Byte-Code Type}.
@xref{Closure Type}.
@item autoload object
@cindex autoload object
@ -227,6 +227,16 @@ Compilation}), or natively-compiled (@pxref{Native Compilation}), or
a function loaded from a dynamic module (@pxref{Dynamic Modules}).
@end defun
@defun interpreted-function-p object
This function returns @code{t} if @var{object} is an interpreted function.
@end defun
@defun closurep object
This function returns @code{t} if @var{object} is a closure, which is
a particular kind of function object. Currently closures are used
for all byte-code functions and all interpreted functions.
@end defun
@defun subr-arity subr
This works like @code{func-arity}, but only for built-in functions and
without symbol indirection. It signals an error for non-built-in
@ -1136,8 +1146,7 @@ Functions}). @xref{describe-symbols example}, for a realistic example
of this.
When defining a lambda expression that is to be used as an anonymous
function, you can in principle use any method to construct the list.
But typically you should use the @code{lambda} macro, or the
function, you should use the @code{lambda} macro, or the
@code{function} special form, or the @code{#'} read syntax:
@defmac lambda args [doc] [interactive] body@dots{}
@ -1145,17 +1154,18 @@ This macro returns an anonymous function with argument list
@var{args}, documentation string @var{doc} (if any), interactive spec
@var{interactive} (if any), and body forms given by @var{body}.
Under dynamic binding, this macro effectively makes @code{lambda}
forms self-quoting: evaluating a form whose @sc{car} is @code{lambda}
yields the form itself:
For example, this macro makes @code{lambda} forms almost self-quoting:
evaluating a form whose @sc{car} is @code{lambda} yields a value that is
almost like the form itself:
@example
(lambda (x) (* x x))
@result{} (lambda (x) (* x x))
@result{} #f(lambda (x) :dynbind (* x x))
@end example
Note that when evaluating under lexical binding the result is a
closure object (@pxref{Closures}).
When evaluating under lexical binding the result is a similar
closure object, where the @code{:dynbind} marker is replaced by the
captured variables (@pxref{Closures}).
The @code{lambda} form has one other effect: it tells the Emacs
evaluator and byte-compiler that its argument is a function, by using
@ -1164,8 +1174,8 @@ evaluator and byte-compiler that its argument is a function, by using
@defspec function function-object
@cindex function quoting
This special form returns @var{function-object} without evaluating it.
In this, it is similar to @code{quote} (@pxref{Quoting}). But unlike
This special form returns the function value of the @var{function-object}.
In many ways, it is similar to @code{quote} (@pxref{Quoting}). But unlike
@code{quote}, it also serves as a note to the Emacs evaluator and
byte-compiler that @var{function-object} is intended to be used as a
function. Assuming @var{function-object} is a valid lambda
@ -1495,7 +1505,7 @@ distinguish between a function cell that is void and one set to
@group
(defun bar (n) (+ n 2))
(symbol-function 'bar)
@result{} (lambda (n) (+ n 2))
@result{} #f(lambda (n) [t] (+ n 2))
@end group
@group
(fset 'baz 'bar)
@ -1608,7 +1618,7 @@ argument list and body forms as the remaining elements:
@example
;; @r{lexical binding is enabled.}
(lambda (x) (* x x))
@result{} (closure (t) (x) (* x x))
@result{} #f(lambda (x) [t] (* x x))
@end example
@noindent

4
doc/lispref/lists.texi
View File

@ -1249,7 +1249,7 @@ this is not guaranteed to happen):
@group
(symbol-function 'add-foo)
@result{} (lambda (x) (nconc '(foo) x))
@result{} #f(lambda (x) [t] (nconc '(foo) x))
@end group
@group
@ -1267,7 +1267,7 @@ this is not guaranteed to happen):
@group
(symbol-function 'add-foo)
@result{} (lambda (x) (nconc '(foo 1 2 3 4) x))
@result{} #f(lambda (x) [t] (nconc '(foo 1 2 3 4) x))
@end group
@end smallexample
@end defun

38
doc/lispref/objects.texi
View File

@ -244,7 +244,7 @@ latter are unique to Emacs Lisp.
* Macro Type:: A method of expanding an expression into another
expression, more fundamental but less pretty.
* Primitive Function Type:: A function written in C, callable from Lisp.
* Byte-Code Type:: A function written in Lisp, then compiled.
* Closure Type:: A function written in Lisp.
* Record Type:: Compound objects with programmer-defined types.
* Type Descriptors:: Objects holding information about types.
* Autoload Type:: A type used for automatically loading seldom-used
@ -1458,18 +1458,24 @@ with the name of the subroutine.
@end group
@end example
@node Byte-Code Type
@subsection Byte-Code Function Type
@node Closure Type
@subsection Closure Function Type
@dfn{Byte-code function objects} are produced by byte-compiling Lisp
code (@pxref{Byte Compilation}). Internally, a byte-code function
object is much like a vector; however, the evaluator handles this data
type specially when it appears in a function call. @xref{Byte-Code
Objects}.
@dfn{Closures} are function objects produced when turning a function
definition into a function value. Closures are used both for
byte-compiled Lisp functions as well as for interpreted Lisp functions.
Closures can be produced by byte-compiling Lisp code (@pxref{Byte
Compilation}) or simply by evaluating a lambda expression without
compiling it, resulting in an interpreted function. Internally,
a closure is much like a vector; however, the evaluator
handles this data type specially when it appears in a function call.
@xref{Closure Objects}.
The printed representation and read syntax for a byte-code function
object is like that for a vector, with an additional @samp{#} before the
opening @samp{[}.
opening @samp{[}. When printed for human consumption, it is printed as
a special kind of list with an additional @samp{#f} before the opening
@samp{(}.
@node Record Type
@subsection Record Type
@ -2042,10 +2048,7 @@ with references to further information.
@xref{Buffer Basics, bufferp}.
@item byte-code-function-p
@xref{Byte-Code Type, byte-code-function-p}.
@item compiled-function-p
@xref{Byte-Code Type, compiled-function-p}.
@xref{Closure Type, byte-code-function-p}.
@item case-table-p
@xref{Case Tables, case-table-p}.
@ -2056,9 +2059,15 @@ with references to further information.
@item char-table-p
@xref{Char-Tables, char-table-p}.
@item closurep
@xref{What Is a Function, closurep}.
@item commandp
@xref{Interactive Call, commandp}.
@item compiled-function-p
@xref{Closure Type, compiled-function-p}.
@item condition-variable-p
@xref{Condition Variables, condition-variable-p}.
@ -2098,6 +2107,9 @@ with references to further information.
@item integerp
@xref{Predicates on Numbers, integerp}.
@item interpreted-function-p
@xref{What Is a Function, interpreted-function-p}.
@item keymapp
@xref{Creating Keymaps, keymapp}.

2
doc/lispref/sequences.texi
View File

@ -1583,7 +1583,7 @@ nonempty vector that is not @code{eq} to any existing vector.
The @code{vconcat} function also allows byte-code function objects as
arguments. This is a special feature to make it easy to access the entire
contents of a byte-code function object. @xref{Byte-Code Objects}.
contents of a byte-code function object. @xref{Closure Objects}.
For other concatenation functions, see @code{mapconcat} in @ref{Mapping
Functions}, @code{concat} in @ref{Creating Strings}, and @code{append}

2
doc/lispref/variables.texi
View File

@ -1079,7 +1079,7 @@ Here is an example:
(let ((x 0)) ; @r{@code{x} is lexically bound.}
(setq my-ticker (lambda ()
(setq x (1+ x)))))
@result{} (closure ((x . 0)) ()
@result{} #f(lambda () [(x 0)]
(setq x (1+ x)))
(funcall my-ticker)

25
etc/NEWS
View File

@ -1767,6 +1767,23 @@ documentation and examples.
* Incompatible Lisp Changes in Emacs 30.1
+++
** Evaluating a 'lambda' returns an object of type 'interpreted-function'.
Instead of representing interpreted functions as lists that start with
either 'lambda' or 'closure', Emacs now represents them as objects
of their own 'interpreted-function' type, which is very similar
to 'byte-code-function' objects (the argument list, docstring, and
interactive forms are placed in the same slots).
Lists that start with 'lambda' are now used only for non-evaluated
functions (in other words, for source code), but for backward compatibility
reasons, 'functionp' still recognizes them as functions and you can
still call them as before.
Thus code that attempts to "dig" into the internal structure of an
interpreted function's object with the likes of 'car' or 'cdr' will
no longer work and will need to use 'aref' instead to extract its
various subparts (when 'interactive-form', 'documentation', and
'help-function-arglist' aren't adequate).
+++
** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'.
Minor modes defined with 'define-globalized-minor-mode', such as
@ -1906,6 +1923,14 @@ unibyte string.
* Lisp Changes in Emacs 30.1
** New types 'closure' and 'interpreted-function'.
'interpreted-function' is the new type used for interpreted functions,
and 'closure' is the common parent type of 'interpreted-function'
and 'byte-code-function'.
Those new types come with the associated new predicates
'closurep' and `interpreted-function-p' as well as a new constructor
'make-interpreted-closure'.
** New function 'help-fns-function-name'.
For named functions, it just returns the name and otherwise
it returns a short "unique" string that identifies the function.

3
lisp/emacs-lisp/byte-opt.el
View File

@ -164,7 +164,7 @@ Earlier variables shadow later ones with the same name.")
;; The byte-code will be really inlined in byte-compile-unfold-bcf.
(byte-compile--check-arity-bytecode form fn)
`(,fn ,@(cdr form)))
((or `(lambda . ,_) `(closure . ,_))
((pred interpreted-function-p)
;; While byte-compile-unfold-bcf can inline dynbind byte-code into
;; letbind byte-code (or any other combination for that matter), we
;; can only inline dynbind source into dynbind source or lexbind
@ -1870,6 +1870,7 @@ See Info node `(elisp) Integer Basics'."
charsetp
;; data.c
arrayp atom bare-symbol-p bool-vector-p bufferp byte-code-function-p
interpreted-function-p closurep
byteorder car-safe cdr-safe char-or-string-p char-table-p
condition-variable-p consp eq floatp indirect-function
integer-or-marker-p integerp keywordp listp markerp

18
lisp/emacs-lisp/bytecomp.el
View File

@ -2915,9 +2915,14 @@ otherwise, print without quoting."
(defun byte-compile--reify-function (fun)
"Return an expression which will evaluate to a function value FUN.
FUN should be an interpreted closure."
(pcase-let* ((`(closure ,env ,args . ,body) fun)
(`(,preamble . ,body) (macroexp-parse-body body))
(renv ()))
(let* ((args (aref fun 0))
(body (aref fun 1))
(env (aref fun 2))
(docstring (function-documentation fun))
(iform (interactive-form fun))
(preamble `(,@(if docstring (list docstring))
,@(if iform (list iform))))
(renv ()))
;; Turn the function's closed vars (if any) into local let bindings.
(dolist (binding env)
(cond
@ -2954,11 +2959,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(if (symbolp form) form "provided"))
fun)
(t
(when (or (symbolp form) (eq (car-safe fun) 'closure))
(when (or (symbolp form) (interpreted-function-p fun))
;; `fun' is a function *value*, so try to recover its
;; corresponding source code.
(when (setq lexical-binding (eq (car-safe fun) 'closure))
(setq fun (byte-compile--reify-function fun)))
(setq lexical-binding (not (null (aref fun 2))))
(setq fun (byte-compile--reify-function fun))
(setq need-a-value t))
;; Expand macros.
(setq fun (byte-compile-preprocess fun))
@ -5148,7 +5153,6 @@ binding slots have been popped."
;; `arglist' is the list of arguments (or t if not recognized).
;; `body' is the body of `lam' (or t if not recognized).
((or `(lambda ,arglist . ,body)
;; `(closure ,_ ,arglist . ,body)
(and `(internal-make-closure ,arglist . ,_) (let body t))
(and (let arglist t) (let body t)))
lam))

38
lisp/emacs-lisp/cconv.el
View File

@ -902,7 +902,7 @@ lexically and dynamically bound symbols actually used by FORM."
(delete-dups cconv--dynbindings)))))
(cons fvs dyns)))))
(defun cconv-make-interpreted-closure (fun env)
(defun cconv-make-interpreted-closure (args body env docstring iform)
"Make a closure for the interpreter.
This is intended to be called at runtime by the ELisp interpreter (when
the code has not been compiled).
@ -911,22 +911,27 @@ ENV is the runtime representation of the lexical environment,
i.e. a list whose elements can be either plain symbols (which indicate
that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE)
for the lexical bindings."
(cl-assert (eq (car-safe fun) 'lambda))
(cl-assert (consp body))
(cl-assert (listp args))
(let ((lexvars (delq nil (mapcar #'car-safe env))))
(if (or (null lexvars)
;; Functions with a `:closure-dont-trim-context' marker
;; should keep their whole context untrimmed (bug#59213).
(and (eq :closure-dont-trim-context (nth 2 fun))
;; Check the function doesn't just return the magic keyword.
(nthcdr 3 fun)))
(if (or
;; Functions with a `:closure-dont-trim-context' marker
;; should keep their whole context untrimmed (bug#59213).
(and (eq :closure-dont-trim-context (car body))
;; Check the function doesn't just return the magic keyword.
(cdr body)
;; Drop the magic marker from the closure.
(setq body (cdr body)))
;; There's no var to capture, so skip the analysis.
(null lexvars))
;; The lexical environment is empty, or needs to be preserved,
;; so there's no need to look for free variables.
;; Attempting to replace ,(cdr fun) by a macroexpanded version
;; causes bootstrap to fail.
`(closure ,env . ,(cdr fun))
;; Attempting to replace body by a macroexpanded version
;; caused bootstrap to fail.
(make-interpreted-closure args body env docstring iform)
;; We could try and cache the result of the macroexpansion and
;; `cconv-fv' analysis. Not sure it's worth the trouble.
(let* ((form `#',fun)
(let* ((form `#'(lambda ,args ,iform . ,body))
(expanded-form
(let ((lexical-binding t) ;; Tell macros which dialect is in use.
;; Make the macro aware of any defvar declarations in scope.
@ -935,10 +940,10 @@ for the lexical bindings."
(append env macroexp--dynvars) env)))
(macroexpand-all form macroexpand-all-environment)))
;; Since we macroexpanded the body, we may as well use that.
(expanded-fun-cdr
(expanded-fun-body
(pcase expanded-form
(`#'(lambda . ,cdr) cdr)
(_ (cdr fun))))
(`#'(lambda ,_args ,_iform . ,newbody) newbody)
(_ body)))
(dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
(fvs (cconv-fv expanded-form lexvars dynvars))
@ -946,7 +951,8 @@ for the lexical bindings."
(cdr fvs))))
;; Never return a nil env, since nil means to use the dynbind
;; dialect of ELisp.
`(closure ,(or newenv '(t)) . ,expanded-fun-cdr)))))
(make-interpreted-closure args expanded-fun-body (or newenv '(t))
docstring iform)))))
(provide 'cconv)

15
lisp/emacs-lisp/cl-preloaded.el
View File

@ -444,13 +444,24 @@ For this build of Emacs it's %dbit."
)
(cl--define-built-in-type compiled-function (function)
"Abstract type of functions that have been compiled.")
(cl--define-built-in-type byte-code-function (compiled-function)
(cl--define-built-in-type closure (function)
"Abstract type of functions represented by a vector-like object.
You can access the object's internals with `aref'.
The fields are used as follows:
0 [args] Argument list (either a list or an integer)
1 [code] Either a byte-code string or a list of Lisp forms
2 [constants] Either vector of constants or a lexical environment
3 [stackdepth] Maximum amount of stack depth used by the byte-code
4 [docstring] The documentation, or a reference to it
5 [iform] The interactive form (if present)")
(cl--define-built-in-type byte-code-function (compiled-function closure)
"Type of functions that have been byte-compiled.")
(cl--define-built-in-type subr (atom)
"Abstract type of functions compiled to machine code.")
(cl--define-built-in-type module-function (function)
"Type of functions provided via the module API.")
(cl--define-built-in-type interpreted-function (function)
(cl--define-built-in-type interpreted-function (closure)
"Type of functions that have not been compiled.")
(cl--define-built-in-type special-form (subr)
"Type of the core syntactic elements of the Emacs Lisp language.")

32
lisp/emacs-lisp/cl-print.el
View File

@ -237,6 +237,38 @@ into a button whose action shows the function's disassembly.")
'byte-code-function object)))))
(princ ")" stream)))
(cl-defmethod cl-print-object ((object interpreted-function) stream)
(unless stream (setq stream standard-output))
(princ "#f(lambda " stream)
(let ((args (help-function-arglist object 'preserve-names)))
;; It's tempting to print the arglist from the "usage" info in the
;; doc (e.g. for `&key` args), but that only makes sense if we
;; *don't* print the body, since otherwise the body will tend to
;; refer to args that don't appear in the arglist.
(if args
(prin1 args stream)
(princ "()" stream)))
(let ((env (aref object 2)))
(if (null env)
(princ " :dynbind" stream)
(princ " " stream)
(cl-print-object
(vconcat (mapcar (lambda (x) (if (consp x) (list (car x) (cdr x)) x))
env))
stream)))
(let* ((doc (documentation object 'raw)))
(when doc
(princ " " stream)
(prin1 doc stream)))
(let ((inter (interactive-form object)))
(when inter
(princ " " stream)
(cl-print-object inter stream)))
(dolist (exp (aref object 1))
(princ " " stream)
(cl-print-object exp stream))
(princ ")" stream))
;; This belongs in oclosure.el, of course, but some load-ordering issues make it
;; complicated.
(cl-defmethod cl-print-object ((object accessor) stream)

2
lisp/emacs-lisp/comp-common.el
View File

@ -118,7 +118,9 @@ Used to modify the compiler environment."
(buffer-substring
(function ((or integer marker) (or integer marker)) string))
(bufferp (function (t) boolean))
(closurep (function (t) boolean))
(byte-code-function-p (function (t) boolean))
(interpreted-function-p (function (t) boolean))
(capitalize (function ((or integer string)) (or integer string)))
(car (function (list) t))
(car-less-than-car (function (list list) boolean))

6
lisp/emacs-lisp/disass.el
View File

@ -129,7 +129,7 @@ redefine OBJECT if it is a symbol."
(setq args (help-function-arglist obj)) ;save arg list
(setq obj (cdr obj)) ;throw lambda away
(setq obj (cdr obj)))
((byte-code-function-p obj)
((closurep obj)
(setq args (help-function-arglist obj)))
(t (error "Compilation failed")))
(if (zerop indent) ; not a nested function
@ -178,7 +178,9 @@ redefine OBJECT if it is a symbol."
(t
(insert "Uncompiled body: ")
(let ((print-escape-newlines t))
(prin1 (macroexp-progn obj)
(prin1 (macroexp-progn (if (interpreted-function-p obj)
(aref obj 1)
obj))
(current-buffer))))))
(if interactive-p
(message "")))

2
lisp/emacs-lisp/edebug.el
View File

@ -4254,7 +4254,7 @@ code location is known."
((pred edebug--symbol-prefixed-p) nil)
(_
(when (and skip-next-lambda
(not (memq (car-safe fun) '(closure lambda))))
(not (interpreted-function-p fun)))
(warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun))
(unless skip-next-lambda
(edebug--unwrap-frame new-frame)

1
lisp/emacs-lisp/lisp-mode.el
View File

@ -1347,7 +1347,6 @@ Lisp function does not specify a special indentation."
(put 'condition-case 'lisp-indent-function 2)
(put 'handler-case 'lisp-indent-function 1) ;CL
(put 'unwind-protect 'lisp-indent-function 1)
(put 'closure 'lisp-indent-function 2)
(defun indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.

6
lisp/emacs-lisp/nadvice.el
View File

@ -185,7 +185,7 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
(defun advice--interactive-form-1 (function)
"Like `interactive-form' but preserves the static context if needed."
(let ((if (interactive-form function)))
(if (or (null if) (not (eq 'closure (car-safe function))))
(if (not (and if (interpreted-function-p function)))
if
(cl-assert (eq 'interactive (car if)))
(let ((form (cadr if)))
@ -193,14 +193,14 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
if
;; The interactive is expected to be run in the static context
;; that the function captured.
(let ((ctx (nth 1 function)))
(let ((ctx (aref function 2)))
`(interactive
,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form)))
;; If the form jut returns a function, preserve the fact that
;; it just returns a function, which is an info we use in
;; `advice--make-interactive-form'.
(if (eq 'lambda (car-safe f))
`',(eval form ctx)
(eval form ctx)
`(eval ',form ',ctx))))))))))
(defun advice--interactive-form (function)

96
lisp/emacs-lisp/oclosure.el
View File

@ -146,7 +146,7 @@
(setf (cl--find-class 'oclosure)
(oclosure--class-make 'oclosure
"The root parent of all OClosure types"
nil (list (cl--find-class 'function))
nil (list (cl--find-class 'closure))
'(oclosure)))
(defun oclosure--p (oclosure)
(not (not (oclosure-type oclosure))))
@ -431,75 +431,57 @@ ARGS and BODY are the same as for `lambda'."
(defun oclosure--fix-type (_ignore oclosure)
"Helper function to implement `oclosure-lambda' via a macro.
This has 2 uses:
- For interpreted code, this converts the representation of type information
by moving it from the docstring to the environment.
- For compiled code, this is used as a marker which cconv uses to check that
immutable fields are indeed not mutated."
(if (byte-code-function-p oclosure)
;; Actually, this should never happen since `cconv.el' should have
;; optimized away the call to this function.
oclosure
;; For byte-coded functions, we store the type as a symbol in the docstring
;; slot. For interpreted functions, there's no specific docstring slot
;; so `Ffunction' turns the symbol into a string.
;; We thus have convert it back into a symbol (via `intern') and then
;; stuff it into the environment part of the closure with a special
;; marker so we can distinguish this entry from actual variables.
(cl-assert (eq 'closure (car-safe oclosure)))
(let ((typename (nth 3 oclosure))) ;; The "docstring".
(cl-assert (stringp typename))
(push (cons :type (intern typename))
(cadr oclosure))
oclosure)))
This is used as a marker which cconv uses to check that
immutable fields are indeed not mutated."
(cl-assert (closurep oclosure))
;; This should happen only for interpreted closures since `cconv.el'
;; should have optimized away the call to this function.
oclosure)
(defun oclosure--copy (oclosure mutlist &rest args)
(cl-assert (closurep oclosure))
(if (byte-code-function-p oclosure)
(apply #'make-closure oclosure
(if (null mutlist)
args
(mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
(cl-assert (eq 'closure (car-safe oclosure))
nil "oclosure not closure: %S" oclosure)
(cl-assert (eq :type (caar (cadr oclosure))))
(let ((env (cadr oclosure)))
`(closure
(,(car env)
,@(named-let loop ((env (cdr env)) (args args))
(when args
(cons (cons (caar env) (car args))
(loop (cdr env) (cdr args)))))
,@(nthcdr (1+ (length args)) env))
,@(nthcdr 2 oclosure)))))
(cl-assert (consp (aref oclosure 1)))
(cl-assert (null (aref oclosure 3)))
(cl-assert (symbolp (aref oclosure 4)))
(let ((env (aref oclosure 2)))
(make-interpreted-closure
(aref oclosure 0)
(aref oclosure 1)
(named-let loop ((env env) (args args))
(if (null args) env
(cons (cons (caar env) (car args))
(loop (cdr env) (cdr args)))))
(aref oclosure 4)
(if (> (length oclosure) 5)
`(interactive ,(aref oclosure 5)))))))
(defun oclosure--get (oclosure index mutable)
(if (byte-code-function-p oclosure)
(let* ((csts (aref oclosure 2))
(v (aref csts index)))
(if mutable (car v) v))
(cl-assert (eq 'closure (car-safe oclosure)))
(cl-assert (eq :type (caar (cadr oclosure))))
(cdr (nth (1+ index) (cadr oclosure)))))
(cl-assert (closurep oclosure))
(let* ((csts (aref oclosure 2)))
(if (vectorp csts)
(let ((v (aref csts index)))
(if mutable (car v) v))
(cdr (nth index csts)))))
(defun oclosure--set (v oclosure index)
(if (byte-code-function-p oclosure)
(let* ((csts (aref oclosure 2))
(cell (aref csts index)))
(setcar cell v))
(cl-assert (eq 'closure (car-safe oclosure)))
(cl-assert (eq :type (caar (cadr oclosure))))
(setcdr (nth (1+ index) (cadr oclosure)) v)))
(cl-assert (closurep oclosure))
(let ((csts (aref oclosure 2)))
(if (vectorp csts)
(let ((cell (aref csts index)))
(setcar cell v))
(setcdr (nth index csts) v))))
(defun oclosure-type (oclosure)
"Return the type of OCLOSURE, or nil if the arg is not a OClosure."
(if (byte-code-function-p oclosure)
(let ((type (and (> (length oclosure) 4) (aref oclosure 4))))
(if (symbolp type) type))
(and (eq 'closure (car-safe oclosure))
(let* ((env (car-safe (cdr oclosure)))
(first-var (car-safe env)))
(and (eq :type (car-safe first-var))
(cdr first-var))))))
"Return the type of OCLOSURE, or nil if the arg is not an OClosure."
(and (closurep oclosure)
(> (length oclosure) 4)
(let ((type (aref oclosure 4)))
(if (symbolp type) type))))
(defconst oclosure--accessor-prototype
;; Use `oclosure--lambda' to circumvent a bootstrapping problem:

3
lisp/help.el
View File

@ -2355,9 +2355,8 @@ the same names as used in the original source code, when possible."
;; If definition is a macro, find the function inside it.
(if (eq (car-safe def) 'macro) (setq def (cdr def)))
(cond
((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
((and (closurep def) (listp (aref def 0))) (aref def 0))
((eq (car-safe def) 'lambda) (nth 1 def))
((eq (car-safe def) 'closure) (nth 2 def))
((and (featurep 'native-compile)
(subrp def)
(listp (subr-native-lambda-list def)))

5
lisp/profiler.el
View File

@ -275,10 +275,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
(define-hash-table-test 'profiler-function-equal #'function-equal
(lambda (f) (cond
((byte-code-function-p f) (aref f 1))
((eq (car-safe f) 'closure) (cddr f))
(t f))))
(lambda (f) (if (closurep f) (aref f 1) f)))
(defun profiler-calltree-build-unified (tree log)
;; Let's try to unify all those partial backtraces into a single

5
lisp/simple.el
View File

@ -2703,15 +2703,14 @@ function as needed."
(or (stringp doc)
(fixnump doc) (fixnump (cdr-safe doc))))))
(pcase function
((pred byte-code-function-p)
((pred closurep)
(when (> (length function) 4)
(let ((doc (aref function 4)))
(when (funcall docstring-p doc) doc))))
((or (pred stringp) (pred vectorp)) "Keyboard macro.")
(`(keymap . ,_)
"Prefix command (definition is a keymap associating keystrokes with commands).")
((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body)
`(autoload ,_file . ,body))
((or `(lambda ,_args . ,body) `(autoload ,_file . ,body))
(let ((doc (car body)))
(when (funcall docstring-p doc)
doc)))

6
src/callint.c
View File

@ -319,10 +319,10 @@ invoke it (via an `interactive' spec that contains, for instance, an
{
Lisp_Object funval = Findirect_function (function, Qt);
uintmax_t events = num_input_events;
Lisp_Object env = CLOSUREP (funval) && CONSP (AREF (funval, CLOSURE_CODE))
? AREF (funval, CLOSURE_CONSTANTS) : Qnil;
/* Compute the arg values using the user's expression. */
specs = Feval (specs,
CONSP (funval) && EQ (Qclosure, XCAR (funval))
? CAR_SAFE (XCDR (funval)) : Qnil);
specs = Feval (specs, env);
if (events != num_input_events || !NILP (record_flag))
{
/* We should record this command on the command history.

46
src/data.c
View File

@ -248,7 +248,9 @@ a fixed set of types. */)
return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form
: SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp
: Qprimitive_function;
case PVEC_CLOSURE: return Qcompiled_function;
case PVEC_CLOSURE:
return CONSP (AREF (object, CLOSURE_CODE))
? Qinterpreted_function : Qbyte_code_function;
case PVEC_BUFFER: return Qbuffer;
case PVEC_CHAR_TABLE: return Qchar_table;
case PVEC_BOOL_VECTOR: return Qbool_vector;
@ -518,12 +520,32 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
return Qnil;
}
DEFUN ("closurep", Fclosurep, Sclosurep,
1, 1, 0,
doc: /* Return t if OBJECT is a function of type `closure'. */)
(Lisp_Object object)
{
if (CLOSUREP (object))
return Qt;
return Qnil;
}
DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
1, 1, 0,
doc: /* Return t if OBJECT is a byte-compiled function object. */)
(Lisp_Object object)
{
if (CLOSUREP (object))
if (CLOSUREP (object) && STRINGP (AREF (object, CLOSURE_CODE)))
return Qt;
return Qnil;
}
DEFUN ("interpreted-function-p", Finterpreted_function_p,
Sinterpreted_function_p, 1, 1, 0,
doc: /* Return t if OBJECT is a function of type `interpreted-function'. */)
(Lisp_Object object)
{
if (CLOSUREP (object) && CONSP (AREF (object, CLOSURE_CODE)))
return Qt;
return Qnil;
}
@ -1174,17 +1196,11 @@ Value, if non-nil, is a list (interactive SPEC). */)
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
if (EQ (funcar, Qclosure)
|| EQ (funcar, Qlambda))
if (EQ (funcar, Qlambda))
{
Lisp_Object form = Fcdr (XCDR (fun));
if (EQ (funcar, Qclosure))
form = Fcdr (form);
Lisp_Object spec = Fassq (Qinteractive, form);
if (NILP (spec) && VALID_DOCSTRING_P (CAR_SAFE (form)))
/* A "docstring" is a sign that we may have an OClosure. */
genfun = true;
else if (NILP (Fcdr (Fcdr (spec))))
if (NILP (Fcdr (Fcdr (spec))))
return spec;
else
return list2 (Qinteractive, Fcar (Fcdr (spec)));
@ -1257,12 +1273,9 @@ The value, if non-nil, is a list of mode name symbols. */)
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
if (EQ (funcar, Qclosure)
|| EQ (funcar, Qlambda))
if (EQ (funcar, Qlambda))
{
Lisp_Object form = Fcdr (XCDR (fun));
if (EQ (funcar, Qclosure))
form = Fcdr (form);
return Fcdr (Fcdr (Fassq (Qinteractive, form)));
}
}
@ -4224,7 +4237,8 @@ syms_of_data (void)
DEFSYM (Qspecial_form, "special-form");
DEFSYM (Qprimitive_function, "primitive-function");
DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
DEFSYM (Qcompiled_function, "compiled-function");
DEFSYM (Qbyte_code_function, "byte-code-function");
DEFSYM (Qinterpreted_function, "interpreted-function");
DEFSYM (Qbuffer, "buffer");
DEFSYM (Qframe, "frame");
DEFSYM (Qvector, "vector");
@ -4289,6 +4303,8 @@ syms_of_data (void)
defsubr (&Smarkerp);
defsubr (&Ssubrp);
defsubr (&Sbyte_code_function_p);
defsubr (&Sinterpreted_function_p);
defsubr (&Sclosurep);
defsubr (&Smodule_function_p);
defsubr (&Schar_or_string_p);
defsubr (&Sthreadp);

148
src/eval.c
View File

@ -510,6 +510,33 @@ usage: (quote ARG) */)
return XCAR (args);
}
DEFUN ("make-interpreted-closure", Fmake_interpreted_closure,
Smake_interpreted_closure, 3, 5, 0,
doc: /* Make an interpreted closure.
ARGS should be the list of formal arguments.
BODY should be a non-empty list of forms.
ENV should be a lexical environment, like the second argument of `eval'.
IFORM if non-nil should be of the form (interactive ...). */)
(Lisp_Object args, Lisp_Object body, Lisp_Object env,
Lisp_Object docstring, Lisp_Object iform)
{
CHECK_CONS (body); /* Make sure it's not confused with byte-code! */
CHECK_LIST (args);
CHECK_LIST (iform);
Lisp_Object ifcdr = Fcdr (iform);
Lisp_Object slots[] = { args, body, env, Qnil, docstring,
NILP (Fcdr (ifcdr))
? Fcar (ifcdr)
: CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr)) };
/* Adjusting the size is indispensable since, as for byte-code objects,
we distinguish interactive functions by the presence or absence of the
iform slot. */
Lisp_Object val
= Fvector (!NILP (iform) ? 6 : !NILP (docstring) ? 5 : 3, slots);
XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE);
return val;
}
DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
doc: /* Like `quote', but preferred for objects which are functions.
In byte compilation, `function' causes its argument to be handled by
@ -525,33 +552,55 @@ usage: (function ARG) */)
if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
if (!NILP (Vinternal_interpreter_environment)
&& CONSP (quoted)
if (CONSP (quoted)
&& EQ (XCAR (quoted), Qlambda))
{ /* This is a lambda expression within a lexical environment;
return an interpreted closure instead of a simple lambda. */
Lisp_Object cdr = XCDR (quoted);
Lisp_Object tmp = cdr;
if (CONSP (tmp)
&& (tmp = XCDR (tmp), CONSP (tmp))
&& (tmp = XCAR (tmp), CONSP (tmp))
&& (EQ (QCdocumentation, XCAR (tmp))))
{ /* Handle the special (:documentation <form>) to build the docstring
Lisp_Object args = Fcar (cdr);
cdr = Fcdr (cdr);
Lisp_Object docstring = Qnil, iform = Qnil;
if (CONSP (cdr))
{
docstring = XCAR (cdr);
if (STRINGP (docstring))
{
Lisp_Object tmp = XCDR (cdr);
if (!NILP (tmp))
cdr = tmp;
else /* It's not a docstring, it's a return value. */
docstring = Qnil;
}
/* Handle the special (:documentation <form>) to build the docstring
dynamically. */
Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp)));
if (SYMBOLP (docstring) && !NILP (docstring))
/* Hack for OClosures: Allow the docstring to be a symbol
* (the OClosure's type). */
docstring = Fsymbol_name (docstring);
CHECK_STRING (docstring);
cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
}
if (NILP (Vinternal_make_interpreted_closure_function))
return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, cdr));
else if (CONSP (docstring)
&& EQ (QCdocumentation, XCAR (docstring))
&& (docstring = eval_sub (Fcar (XCDR (docstring))),
true))
cdr = XCDR (cdr);
else
docstring = Qnil; /* Not a docstring after all. */
}
if (CONSP (cdr))
{
iform = XCAR (cdr);
if (CONSP (iform)
&& EQ (Qinteractive, XCAR (iform)))
cdr = XCDR (cdr);
else
iform = Qnil; /* Not an interactive-form after all. */
}
if (NILP (cdr))
cdr = Fcons (Qnil, Qnil); /* Make sure the body is never empty! */
if (NILP (Vinternal_interpreter_environment)
|| NILP (Vinternal_make_interpreted_closure_function))
return Fmake_interpreted_closure
(args, cdr, Vinternal_interpreter_environment, docstring, iform);
else
return call2 (Vinternal_make_interpreted_closure_function,
Fcons (Qlambda, cdr),
Vinternal_interpreter_environment);
return call5 (Vinternal_make_interpreted_closure_function,
args, cdr, Vinternal_interpreter_environment,
docstring, iform);
}
else
/* Simply quote the argument. */
@ -2193,15 +2242,12 @@ then strings and vectors are not accepted. */)
else
{
Lisp_Object body = CDR_SAFE (XCDR (fun));
if (EQ (funcar, Qclosure))
body = CDR_SAFE (body);
else if (!EQ (funcar, Qlambda))
if (!EQ (funcar, Qlambda))
return Qnil;
if (!NILP (Fassq (Qinteractive, body)))
return Qt;
else if (VALID_DOCSTRING_P (CAR_SAFE (body)))
/* A "docstring" is a sign that we may have an OClosure. */
genfun = true;
else
return Qnil;
}
}
@ -2611,8 +2657,7 @@ eval_sub (Lisp_Object form)
exp = unbind_to (count1, exp);
val = eval_sub (exp);
}
else if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
else if (EQ (funcar, Qlambda))
return apply_lambda (fun, original_args, count);
else
xsignal1 (Qinvalid_function, original_fun);
@ -2950,7 +2995,7 @@ FUNCTIONP (Lisp_Object object)
else if (CONSP (object))
{
Lisp_Object car = XCAR (object);
return EQ (car, Qlambda) || EQ (car, Qclosure);
return EQ (car, Qlambda);
}
else
return false;
@ -2980,8 +3025,7 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args)
Lisp_Object funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
if (EQ (funcar, Qlambda))
return funcall_lambda (fun, numargs, args);
else if (EQ (funcar, Qautoload))
{
@ -3165,16 +3209,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
if (CONSP (fun))
{
if (EQ (XCAR (fun), Qclosure))
{
Lisp_Object cdr = XCDR (fun); /* Drop `closure'. */
if (! CONSP (cdr))
xsignal1 (Qinvalid_function, fun);
fun = cdr;
lexenv = XCAR (fun);
}
else
lexenv = Qnil;
lexenv = Qnil;
syms_left = XCDR (fun);
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
@ -3189,10 +3224,12 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
engine directly. */
if (FIXNUMP (syms_left))
return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector);
/* Otherwise the bytecode object uses dynamic binding and the
ARGLIST slot contains a standard formal argument list whose
variables are bound dynamically below. */
lexenv = Qnil;
/* Otherwise the closure either is interpreted
or uses dynamic binding and the ARGLIST slot contains a standard
formal argument list whose variables are bound dynamically below. */
lexenv = CONSP (AREF (fun, CLOSURE_CODE))
? AREF (fun, CLOSURE_CONSTANTS)
: Qnil;
}
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
@ -3280,7 +3317,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
val = XSUBR (fun)->function.a0 ();
}
else
val = exec_byte_code (fun, 0, 0, NULL);
{
eassert (CLOSUREP (fun));
val = CONSP (AREF (fun, CLOSURE_CODE))
/* Interpreted function. */
? Fprogn (AREF (fun, CLOSURE_CODE))
/* Dynbound bytecode. */
: exec_byte_code (fun, 0, 0, NULL);
}
return unbind_to (count, val);
}
@ -3330,8 +3374,7 @@ function with `&rest' args, or `unevalled' for a special form. */)
funcar = XCAR (function);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original);
if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
if (EQ (funcar, Qlambda))
result = lambda_arity (function);
else if (EQ (funcar, Qautoload))
{
@ -3352,11 +3395,6 @@ lambda_arity (Lisp_Object fun)
if (CONSP (fun))
{
if (EQ (XCAR (fun), Qclosure))
{
fun = XCDR (fun); /* Drop `closure'. */
CHECK_CONS (fun);
}
syms_left = XCDR (fun);
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
@ -4265,7 +4303,6 @@ before making `inhibit-quit' nil. */);
DEFSYM (Qcommandp, "commandp");
DEFSYM (Qand_rest, "&rest");
DEFSYM (Qand_optional, "&optional");
DEFSYM (Qclosure, "closure");
DEFSYM (QCdocumentation, ":documentation");
DEFSYM (Qdebug, "debug");
DEFSYM (Qdebug_early, "debug-early");
@ -4423,6 +4460,7 @@ alist of active lexical bindings. */);
defsubr (&Ssetq);
defsubr (&Squote);
defsubr (&Sfunction);
defsubr (&Smake_interpreted_closure);
defsubr (&Sdefault_toplevel_value);
defsubr (&Sset_default_toplevel_value);
defsubr (&Sdefvar);

33
src/lread.c
View File

@ -3523,25 +3523,32 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
}
}
if (!(size >= CLOSURE_STACK_DEPTH + 1 && size <= CLOSURE_INTERACTIVE + 1
if (!(size >= CLOSURE_STACK_DEPTH && size <= CLOSURE_INTERACTIVE + 1
&& (FIXNUMP (vec[CLOSURE_ARGLIST])
|| CONSP (vec[CLOSURE_ARGLIST])
|| NILP (vec[CLOSURE_ARGLIST]))
&& STRINGP (vec[CLOSURE_CODE])
&& VECTORP (vec[CLOSURE_CONSTANTS])
&& FIXNATP (vec[CLOSURE_STACK_DEPTH])))
&& ((STRINGP (vec[CLOSURE_CODE]) /* Byte-code function. */
&& VECTORP (vec[CLOSURE_CONSTANTS])
&& size > CLOSURE_STACK_DEPTH
&& (FIXNATP (vec[CLOSURE_STACK_DEPTH])))
|| (CONSP (vec[CLOSURE_CODE]) /* Interpreted function. */
&& (CONSP (vec[CLOSURE_CONSTANTS])
|| NILP (vec[CLOSURE_CONSTANTS]))))))
invalid_syntax ("Invalid byte-code object", readcharfun);
if (STRING_MULTIBYTE (vec[CLOSURE_CODE]))
/* BYTESTR must have been produced by Emacs 20.2 or earlier
because it produced a raw 8-bit string for byte-code and
now such a byte-code string is loaded as multibyte with
raw 8-bit characters converted to multibyte form.
Convert them back to the original unibyte form. */
vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]);
if (STRINGP (vec[CLOSURE_CODE]))
{
if (STRING_MULTIBYTE (vec[CLOSURE_CODE]))
/* BYTESTR must have been produced by Emacs 20.2 or earlier
because it produced a raw 8-bit string for byte-code and
now such a byte-code string is loaded as multibyte with
raw 8-bit characters converted to multibyte form.
Convert them back to the original unibyte form. */
vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]);
/* Bytecode must be immovable. */
pin_string (vec[CLOSURE_CODE]);
/* Bytecode must be immovable. */
pin_string (vec[CLOSURE_CODE]);
}
XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE);
return obj;

8
src/profiler.c
View File

@ -170,9 +170,7 @@ trace_hash (Lisp_Object *trace, int depth)
{
Lisp_Object f = trace[i];
EMACS_UINT hash1
= (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE))
: (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f)))
? XHASH (XCDR (XCDR (f))) : XHASH (f));
= (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE)) : XHASH (f));
hash = sxhash_combine (hash, hash1);
}
return hash;
@ -677,10 +675,6 @@ the same lambda expression, or are really unrelated function. */)
res = true;
else if (CLOSUREP (f1) && CLOSUREP (f2))
res = EQ (AREF (f1, CLOSURE_CODE), AREF (f2, CLOSURE_CODE));
else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2))
&& EQ (Qclosure, XCAR (f1))
&& EQ (Qclosure, XCAR (f2)))
res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2)));
else
res = false;
return res ? Qt : Qnil;

46
test/lisp/emacs-lisp/macroexp-resources/vk.el
View File

@ -78,29 +78,31 @@
(defconst vk-val3 (eval-when-compile (vk-f3 0)))
(defconst vk-f4 '(lambda (x)
(defvar vk-v4)
(let ((vk-v4 31)
(y 32))
(ignore vk-v4 x y)
(list
(vk-variable-kind vk-a) ; dyn
(vk-variable-kind vk-b) ; dyn
(vk-variable-kind vk-v4) ; dyn
(vk-variable-kind x) ; dyn
(vk-variable-kind y))))) ; dyn
(defconst vk-f4 (eval '(lambda (x)
(defvar vk-v4)
(let ((vk-v4 31)
(y 32))
(ignore vk-v4 x y)
(list
(vk-variable-kind vk-a) ; dyn
(vk-variable-kind vk-b) ; dyn
(vk-variable-kind vk-v4) ; dyn
(vk-variable-kind x) ; dyn
(vk-variable-kind y)))) ; dyn
nil))
(defconst vk-f5 '(closure (t) (x)
(defvar vk-v5)
(let ((vk-v5 41)
(y 42))
(ignore vk-v5 x y)
(list
(vk-variable-kind vk-a) ; dyn
(vk-variable-kind vk-b) ; dyn
(vk-variable-kind vk-v5) ; dyn
(vk-variable-kind x) ; lex
(vk-variable-kind y))))) ; lex
(defconst vk-f5 (eval '(lambda (x)
(defvar vk-v5)
(let ((vk-v5 41)
(y 42))
(ignore vk-v5 x y)
(list
(vk-variable-kind vk-a) ; dyn
(vk-variable-kind vk-b) ; dyn
(vk-variable-kind vk-v5) ; dyn
(vk-variable-kind x) ; lex
(vk-variable-kind y)))) ; lex
t))
(defun vk-f6 ()
(eval '(progn

5
test/lisp/erc/resources/erc-d/erc-d-tests.el
View File

@ -367,8 +367,9 @@
(should (equal (funcall it) "foo3foo")))
(ert-info ("Exits clean")
(when (listp (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled
(should (eq 'closure (car (alist-get 'f (erc-d-dialog-vars dialog))))))
(when (interpreted-function-p
(alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled
(should (aref (alist-get 'f (erc-d-dialog-vars dialog)) 2)))
(should-not (funcall it))
(should (equal (erc-d-dialog-vars dialog)
`((:a . 1)

10
test/lisp/help-fns-tests.el
View File

@ -63,14 +63,14 @@ Return first line of the output of (describe-function-1 FUNC)."
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-defun ()
(let ((regexp (if (featurep 'native-compile)
"a subr-native-elisp in .+subr\\.el"
"a compiled-function in .+subr\\.el"))
(let ((regexp "a \\([^ ]+\\) in .+subr\\.el")
(result (help-fns-tests--describe-function 'last)))
(should (string-match regexp result))))
(should (string-match regexp result))
(should (member (match-string 1 result)
'("subr-native-elisp" "byte-code-function")))))
(ert-deftest help-fns-test-lisp-defsubst ()
(let ((regexp "a compiled-function in .+subr\\.el")
(let ((regexp "a byte-code-function in .+subr\\.el")
(result (help-fns-tests--describe-function 'posn-window)))
(should (string-match regexp result))))