1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-10 08:10:21 -08:00

Use a dedicated type to represent interpreted-function values

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

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. * Docs and Compilation:: Dynamic loading of documentation strings.
* Eval During Compile:: Code to be evaluated when you compile. * Eval During Compile:: Code to be evaluated when you compile.
* Compiler Errors:: Handling compiler error messages. * 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. * Disassembly:: Disassembling byte-code; how to read byte-code.
@end menu @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; definition of @var{symbol} must be the actual code for the function;
@code{byte-compile} does not handle function indirection. The return @code{byte-compile} does not handle function indirection. The return
value is the byte-code function object which is the compiled 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 @example
@group @group
@ -487,21 +487,22 @@ string for details.
using @code{error}. If so, set @code{byte-compile-error-on-warn} to a using @code{error}. If so, set @code{byte-compile-error-on-warn} to a
non-@code{nil} value. non-@code{nil} value.
@node Byte-Code Objects @node Closure Objects
@section Byte-Code Function Objects @section Closure Function Objects
@cindex compiled function @cindex compiled function
@cindex byte-code function @cindex byte-code function
@cindex byte-code object @cindex byte-code object
Byte-compiled functions have a special data type: they are Byte-compiled functions use a special data type: they are closures.
@dfn{byte-code function objects}. Whenever such an object appears as Closures are used both for byte-compiled Lisp functions as well as for
a function to be called, Emacs uses the byte-code interpreter to interpreted Lisp functions. Whenever such an object appears as
execute the byte-code. 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 elements can be accessed using @code{aref}. Its printed
representation is like that for a vector, with an additional @samp{#} 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 there is no maximum number, but only the first six elements have any
normal use. They are: 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 the argument list uses @code{&rest}, then bit 7 is set; otherwise it's
cleared. 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 before executing the byte code. If @var{argdesc} is an integer, the
arguments will be instead pushed onto the stack of the byte-code arguments will be instead pushed onto the stack of the byte-code
interpreter, before executing the code. interpreter, before executing the code.
@item byte-code @item code
The string containing the byte-code instructions. 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 @item constants
The vector of Lisp objects referenced by the byte code. These include For byte-compiled functions, this holds the vector of Lisp objects
symbols used as function names and variable names. 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 @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 @item docstring
The documentation string (if any); otherwise, @code{nil}. The value may 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}: @code{make-byte-code}:
@defun make-byte-code &rest elements @defun make-byte-code &rest elements
This function constructs and returns a byte-code function object This function constructs and returns a closure which represents the
with @var{elements} as its elements. byte-code function object with @var{elements} as its elements.
@end defun @end defun
You should not try to come up with the elements for a byte-code 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 when you call the function. Always leave it to the byte compiler to
create these objects; it makes the elements consistent (we hope). 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 @node Disassembly
@section Disassembled Byte-Code @section Disassembled Byte-Code
@cindex 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. point is left before the output.
The argument @var{object} can be a function name, a lambda expression 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 Objects}). If it is a lambda expression, @code{disassemble} compiles
it and disassembles the resulting compiled code. it and disassembles the resulting compiled code.
@end deffn @end deffn

View file

@ -2412,7 +2412,7 @@ point where we signaled the original error:
@group @group
Debugger entered--Lisp error: (error "Oops") Debugger entered--Lisp error: (error "Oops")
signal(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") user-error("Oops")
@dots{} @dots{}
eval((handler-bind ((user-error (lambda (err) @dots{} eval((handler-bind ((user-error (lambda (err) @dots{}

View file

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

View file

@ -130,7 +130,7 @@ it also encloses an environment of lexical variable bindings.
@item byte-code function @item byte-code function
A function that has been compiled by the byte compiler. A function that has been compiled by the byte compiler.
@xref{Byte-Code Type}. @xref{Closure Type}.
@item autoload object @item autoload object
@cindex 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}). a function loaded from a dynamic module (@pxref{Dynamic Modules}).
@end defun @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 @defun subr-arity subr
This works like @code{func-arity}, but only for built-in functions and This works like @code{func-arity}, but only for built-in functions and
without symbol indirection. It signals an error for non-built-in 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. of this.
When defining a lambda expression that is to be used as an anonymous 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. function, you should use the @code{lambda} macro, or the
But typically you should use the @code{lambda} macro, or the
@code{function} special form, or the @code{#'} read syntax: @code{function} special form, or the @code{#'} read syntax:
@defmac lambda args [doc] [interactive] body@dots{} @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{args}, documentation string @var{doc} (if any), interactive spec
@var{interactive} (if any), and body forms given by @var{body}. @var{interactive} (if any), and body forms given by @var{body}.
Under dynamic binding, this macro effectively makes @code{lambda} For example, this macro makes @code{lambda} forms almost self-quoting:
forms self-quoting: evaluating a form whose @sc{car} is @code{lambda} evaluating a form whose @sc{car} is @code{lambda} yields a value that is
yields the form itself: almost like the form itself:
@example @example
(lambda (x) (* x x)) (lambda (x) (* x x))
@result{} (lambda (x) (* x x)) @result{} #f(lambda (x) :dynbind (* x x))
@end example @end example
Note that when evaluating under lexical binding the result is a When evaluating under lexical binding the result is a similar
closure object (@pxref{Closures}). 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 The @code{lambda} form has one other effect: it tells the Emacs
evaluator and byte-compiler that its argument is a function, by using 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 @defspec function function-object
@cindex function quoting @cindex function quoting
This special form returns @var{function-object} without evaluating it. This special form returns the function value of the @var{function-object}.
In this, it is similar to @code{quote} (@pxref{Quoting}). But unlike 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 @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 byte-compiler that @var{function-object} is intended to be used as a
function. Assuming @var{function-object} is a valid lambda 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 @group
(defun bar (n) (+ n 2)) (defun bar (n) (+ n 2))
(symbol-function 'bar) (symbol-function 'bar)
@result{} (lambda (n) (+ n 2)) @result{} #f(lambda (n) [t] (+ n 2))
@end group @end group
@group @group
(fset 'baz 'bar) (fset 'baz 'bar)
@ -1608,7 +1618,7 @@ argument list and body forms as the remaining elements:
@example @example
;; @r{lexical binding is enabled.} ;; @r{lexical binding is enabled.}
(lambda (x) (* x x)) (lambda (x) (* x x))
@result{} (closure (t) (x) (* x x)) @result{} #f(lambda (x) [t] (* x x))
@end example @end example
@noindent @noindent

View file

@ -1249,7 +1249,7 @@ this is not guaranteed to happen):
@group @group
(symbol-function 'add-foo) (symbol-function 'add-foo)
@result{} (lambda (x) (nconc '(foo) x)) @result{} #f(lambda (x) [t] (nconc '(foo) x))
@end group @end group
@group @group
@ -1267,7 +1267,7 @@ this is not guaranteed to happen):
@group @group
(symbol-function 'add-foo) (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 group
@end smallexample @end smallexample
@end defun @end defun

View file

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

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 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 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 For other concatenation functions, see @code{mapconcat} in @ref{Mapping
Functions}, @code{concat} in @ref{Creating Strings}, and @code{append} Functions}, @code{concat} in @ref{Creating Strings}, and @code{append}

View file

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

View file

@ -1767,6 +1767,23 @@ documentation and examples.
* Incompatible Lisp Changes in Emacs 30.1 * 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'. ** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'.
Minor modes defined with 'define-globalized-minor-mode', such as Minor modes defined with 'define-globalized-minor-mode', such as
@ -1906,6 +1923,14 @@ unibyte string.
* Lisp Changes in Emacs 30.1 * 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'. ** New function 'help-fns-function-name'.
For named functions, it just returns the name and otherwise For named functions, it just returns the name and otherwise
it returns a short "unique" string that identifies the function. it returns a short "unique" string that identifies the function.

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

View file

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

View file

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

View file

@ -444,13 +444,24 @@ For this build of Emacs it's %dbit."
) )
(cl--define-built-in-type compiled-function (function) (cl--define-built-in-type compiled-function (function)
"Abstract type of functions that have been compiled.") "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.") "Type of functions that have been byte-compiled.")
(cl--define-built-in-type subr (atom) (cl--define-built-in-type subr (atom)
"Abstract type of functions compiled to machine code.") "Abstract type of functions compiled to machine code.")
(cl--define-built-in-type module-function (function) (cl--define-built-in-type module-function (function)
"Type of functions provided via the module API.") "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.") "Type of functions that have not been compiled.")
(cl--define-built-in-type special-form (subr) (cl--define-built-in-type special-form (subr)
"Type of the core syntactic elements of the Emacs Lisp language.") "Type of the core syntactic elements of the Emacs Lisp language.")

View file

@ -237,6 +237,38 @@ into a button whose action shows the function's disassembly.")
'byte-code-function object))))) 'byte-code-function object)))))
(princ ")" stream))) (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 ;; This belongs in oclosure.el, of course, but some load-ordering issues make it
;; complicated. ;; complicated.
(cl-defmethod cl-print-object ((object accessor) stream) (cl-defmethod cl-print-object ((object accessor) stream)

View file

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

View file

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

View file

@ -4254,7 +4254,7 @@ code location is known."
((pred edebug--symbol-prefixed-p) nil) ((pred edebug--symbol-prefixed-p) nil)
(_ (_
(when (and skip-next-lambda (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)) (warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun))
(unless skip-next-lambda (unless skip-next-lambda
(edebug--unwrap-frame new-frame) (edebug--unwrap-frame new-frame)

View file

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

View file

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

View file

@ -146,7 +146,7 @@
(setf (cl--find-class 'oclosure) (setf (cl--find-class 'oclosure)
(oclosure--class-make 'oclosure (oclosure--class-make 'oclosure
"The root parent of all OClosure types" "The root parent of all OClosure types"
nil (list (cl--find-class 'function)) nil (list (cl--find-class 'closure))
'(oclosure))) '(oclosure)))
(defun oclosure--p (oclosure) (defun oclosure--p (oclosure)
(not (not (oclosure-type 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) (defun oclosure--fix-type (_ignore oclosure)
"Helper function to implement `oclosure-lambda' via a macro. "Helper function to implement `oclosure-lambda' via a macro.
This has 2 uses: This is used as a marker which cconv uses to check that
- 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." immutable fields are indeed not mutated."
(if (byte-code-function-p oclosure) (cl-assert (closurep oclosure))
;; Actually, this should never happen since `cconv.el' should have ;; This should happen only for interpreted closures since `cconv.el'
;; optimized away the call to this function. ;; should have optimized away the call to this function.
oclosure 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)))
(defun oclosure--copy (oclosure mutlist &rest args) (defun oclosure--copy (oclosure mutlist &rest args)
(cl-assert (closurep oclosure))
(if (byte-code-function-p oclosure) (if (byte-code-function-p oclosure)
(apply #'make-closure oclosure (apply #'make-closure oclosure
(if (null mutlist) (if (null mutlist)
args args
(mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args))) (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
(cl-assert (eq 'closure (car-safe oclosure)) (cl-assert (consp (aref oclosure 1)))
nil "oclosure not closure: %S" oclosure) (cl-assert (null (aref oclosure 3)))
(cl-assert (eq :type (caar (cadr oclosure)))) (cl-assert (symbolp (aref oclosure 4)))
(let ((env (cadr oclosure))) (let ((env (aref oclosure 2)))
`(closure (make-interpreted-closure
(,(car env) (aref oclosure 0)
,@(named-let loop ((env (cdr env)) (args args)) (aref oclosure 1)
(when args (named-let loop ((env env) (args args))
(if (null args) env
(cons (cons (caar env) (car args)) (cons (cons (caar env) (car args))
(loop (cdr env) (cdr args))))) (loop (cdr env) (cdr args)))))
,@(nthcdr (1+ (length args)) env)) (aref oclosure 4)
,@(nthcdr 2 oclosure))))) (if (> (length oclosure) 5)
`(interactive ,(aref oclosure 5)))))))
(defun oclosure--get (oclosure index mutable) (defun oclosure--get (oclosure index mutable)
(if (byte-code-function-p oclosure) (cl-assert (closurep oclosure))
(let* ((csts (aref oclosure 2)) (let* ((csts (aref oclosure 2)))
(v (aref csts index))) (if (vectorp csts)
(let ((v (aref csts index)))
(if mutable (car v) v)) (if mutable (car v) v))
(cl-assert (eq 'closure (car-safe oclosure))) (cdr (nth index csts)))))
(cl-assert (eq :type (caar (cadr oclosure))))
(cdr (nth (1+ index) (cadr oclosure)))))
(defun oclosure--set (v oclosure index) (defun oclosure--set (v oclosure index)
(if (byte-code-function-p oclosure) (cl-assert (closurep oclosure))
(let* ((csts (aref oclosure 2)) (let ((csts (aref oclosure 2)))
(cell (aref csts index))) (if (vectorp csts)
(let ((cell (aref csts index)))
(setcar cell v)) (setcar cell v))
(cl-assert (eq 'closure (car-safe oclosure))) (setcdr (nth index csts) v))))
(cl-assert (eq :type (caar (cadr oclosure))))
(setcdr (nth (1+ index) (cadr oclosure)) v)))
(defun oclosure-type (oclosure) (defun oclosure-type (oclosure)
"Return the type of OCLOSURE, or nil if the arg is not a OClosure." "Return the type of OCLOSURE, or nil if the arg is not an OClosure."
(if (byte-code-function-p oclosure) (and (closurep oclosure)
(let ((type (and (> (length oclosure) 4) (aref oclosure 4)))) (> (length oclosure) 4)
(if (symbolp type) type)) (let ((type (aref oclosure 4)))
(and (eq 'closure (car-safe oclosure)) (if (symbolp type) type))))
(let* ((env (car-safe (cdr oclosure)))
(first-var (car-safe env)))
(and (eq :type (car-safe first-var))
(cdr first-var))))))
(defconst oclosure--accessor-prototype (defconst oclosure--accessor-prototype
;; Use `oclosure--lambda' to circumvent a bootstrapping problem: ;; Use `oclosure--lambda' to circumvent a bootstrapping problem:

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 definition is a macro, find the function inside it.
(if (eq (car-safe def) 'macro) (setq def (cdr def))) (if (eq (car-safe def) 'macro) (setq def (cdr def)))
(cond (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) 'lambda) (nth 1 def))
((eq (car-safe def) 'closure) (nth 2 def))
((and (featurep 'native-compile) ((and (featurep 'native-compile)
(subrp def) (subrp def)
(listp (subr-native-lambda-list def))) (listp (subr-native-lambda-list def)))

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 (define-hash-table-test 'profiler-function-equal #'function-equal
(lambda (f) (cond (lambda (f) (if (closurep f) (aref f 1) f)))
((byte-code-function-p f) (aref f 1))
((eq (car-safe f) 'closure) (cddr f))
(t f))))
(defun profiler-calltree-build-unified (tree log) (defun profiler-calltree-build-unified (tree log)
;; Let's try to unify all those partial backtraces into a single ;; Let's try to unify all those partial backtraces into a single

View file

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

View file

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

View file

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

View file

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

View file

@ -3523,15 +3523,21 @@ 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]) && (FIXNUMP (vec[CLOSURE_ARGLIST])
|| CONSP (vec[CLOSURE_ARGLIST]) || CONSP (vec[CLOSURE_ARGLIST])
|| NILP (vec[CLOSURE_ARGLIST])) || NILP (vec[CLOSURE_ARGLIST]))
&& STRINGP (vec[CLOSURE_CODE]) && ((STRINGP (vec[CLOSURE_CODE]) /* Byte-code function. */
&& VECTORP (vec[CLOSURE_CONSTANTS]) && VECTORP (vec[CLOSURE_CONSTANTS])
&& FIXNATP (vec[CLOSURE_STACK_DEPTH]))) && 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); invalid_syntax ("Invalid byte-code object", readcharfun);
if (STRINGP (vec[CLOSURE_CODE]))
{
if (STRING_MULTIBYTE (vec[CLOSURE_CODE])) if (STRING_MULTIBYTE (vec[CLOSURE_CODE]))
/* BYTESTR must have been produced by Emacs 20.2 or earlier /* BYTESTR must have been produced by Emacs 20.2 or earlier
because it produced a raw 8-bit string for byte-code and because it produced a raw 8-bit string for byte-code and
@ -3542,6 +3548,7 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
/* Bytecode must be immovable. */ /* Bytecode must be immovable. */
pin_string (vec[CLOSURE_CODE]); pin_string (vec[CLOSURE_CODE]);
}
XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE); XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE);
return obj; return obj;

View file

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

View file

@ -78,7 +78,7 @@
(defconst vk-val3 (eval-when-compile (vk-f3 0))) (defconst vk-val3 (eval-when-compile (vk-f3 0)))
(defconst vk-f4 '(lambda (x) (defconst vk-f4 (eval '(lambda (x)
(defvar vk-v4) (defvar vk-v4)
(let ((vk-v4 31) (let ((vk-v4 31)
(y 32)) (y 32))
@ -88,9 +88,10 @@
(vk-variable-kind vk-b) ; dyn (vk-variable-kind vk-b) ; dyn
(vk-variable-kind vk-v4) ; dyn (vk-variable-kind vk-v4) ; dyn
(vk-variable-kind x) ; dyn (vk-variable-kind x) ; dyn
(vk-variable-kind y))))) ; dyn (vk-variable-kind y)))) ; dyn
nil))
(defconst vk-f5 '(closure (t) (x) (defconst vk-f5 (eval '(lambda (x)
(defvar vk-v5) (defvar vk-v5)
(let ((vk-v5 41) (let ((vk-v5 41)
(y 42)) (y 42))
@ -100,7 +101,8 @@
(vk-variable-kind vk-b) ; dyn (vk-variable-kind vk-b) ; dyn
(vk-variable-kind vk-v5) ; dyn (vk-variable-kind vk-v5) ; dyn
(vk-variable-kind x) ; lex (vk-variable-kind x) ; lex
(vk-variable-kind y))))) ; lex (vk-variable-kind y)))) ; lex
t))
(defun vk-f6 () (defun vk-f6 ()
(eval '(progn (eval '(progn

View file

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

View file

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