aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2024-03-11 16:12:26 -0400
committerStefan Monnier2024-04-18 15:28:36 -0400
commit126be02077520a943252d0d219bb7677466d0168 (patch)
treef762237714f11b303c708f93f09a8dc72426bb2a
parent7842af6095db4384898725fb4a14ebaa11379a34 (diff)
downloademacs-scratch/interpreted-function.tar.gz
emacs-scratch/interpreted-function.zip
Use a dedicated type to represent interpreted-function valuesscratch/interpreted-function
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.
-rw-r--r--doc/lispref/compile.texi61
-rw-r--r--doc/lispref/control.texi2
-rw-r--r--doc/lispref/elisp.texi4
-rw-r--r--doc/lispref/functions.texi36
-rw-r--r--doc/lispref/lists.texi4
-rw-r--r--doc/lispref/objects.texi38
-rw-r--r--doc/lispref/sequences.texi2
-rw-r--r--doc/lispref/variables.texi2
-rw-r--r--etc/NEWS25
-rw-r--r--lisp/emacs-lisp/byte-opt.el3
-rw-r--r--lisp/emacs-lisp/bytecomp.el18
-rw-r--r--lisp/emacs-lisp/cconv.el38
-rw-r--r--lisp/emacs-lisp/cl-preloaded.el15
-rw-r--r--lisp/emacs-lisp/cl-print.el32
-rw-r--r--lisp/emacs-lisp/comp-common.el2
-rw-r--r--lisp/emacs-lisp/disass.el6
-rw-r--r--lisp/emacs-lisp/edebug.el2
-rw-r--r--lisp/emacs-lisp/lisp-mode.el1
-rw-r--r--lisp/emacs-lisp/nadvice.el6
-rw-r--r--lisp/emacs-lisp/oclosure.el96
-rw-r--r--lisp/help.el3
-rw-r--r--lisp/profiler.el5
-rw-r--r--lisp/simple.el5
-rw-r--r--src/callint.c6
-rw-r--r--src/data.c46
-rw-r--r--src/eval.c148
-rw-r--r--src/lread.c35
-rw-r--r--src/profiler.c8
-rw-r--r--test/lisp/emacs-lisp/macroexp-resources/vk.el48
-rw-r--r--test/lisp/erc/resources/erc-d/erc-d-tests.el5
-rw-r--r--test/lisp/help-fns-tests.el10
31 files changed, 437 insertions, 275 deletions
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 00602198da5..3fbf39b349d 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -37,7 +37,7 @@ variable binding for @code{no-byte-compile} into it, like this:
37* Docs and Compilation:: Dynamic loading of documentation strings. 37* Docs and Compilation:: Dynamic loading of documentation strings.
38* Eval During Compile:: Code to be evaluated when you compile. 38* Eval During Compile:: Code to be evaluated when you compile.
39* Compiler Errors:: Handling compiler error messages. 39* Compiler Errors:: Handling compiler error messages.
40* Byte-Code Objects:: The data type used for byte-compiled functions. 40* Closure Objects:: The data type used for byte-compiled functions.
41* Disassembly:: Disassembling byte-code; how to read byte-code. 41* Disassembly:: Disassembling byte-code; how to read byte-code.
42@end menu 42@end menu
43 43
@@ -120,7 +120,7 @@ replacing the previous definition with the compiled one. The function
120definition of @var{symbol} must be the actual code for the function; 120definition of @var{symbol} must be the actual code for the function;
121@code{byte-compile} does not handle function indirection. The return 121@code{byte-compile} does not handle function indirection. The return
122value is the byte-code function object which is the compiled 122value is the byte-code function object which is the compiled
123definition of @var{symbol} (@pxref{Byte-Code Objects}). 123definition of @var{symbol} (@pxref{Closure Objects}).
124 124
125@example 125@example
126@group 126@group
@@ -487,21 +487,22 @@ string for details.
487using @code{error}. If so, set @code{byte-compile-error-on-warn} to a 487using @code{error}. If so, set @code{byte-compile-error-on-warn} to a
488non-@code{nil} value. 488non-@code{nil} value.
489 489
490@node Byte-Code Objects 490@node Closure Objects
491@section Byte-Code Function Objects 491@section Closure Function Objects
492@cindex compiled function 492@cindex compiled function
493@cindex byte-code function 493@cindex byte-code function
494@cindex byte-code object 494@cindex byte-code object
495 495
496 Byte-compiled functions have a special data type: they are 496 Byte-compiled functions use a special data type: they are closures.
497@dfn{byte-code function objects}. Whenever such an object appears as 497Closures are used both for byte-compiled Lisp functions as well as for
498a function to be called, Emacs uses the byte-code interpreter to 498interpreted Lisp functions. Whenever such an object appears as
499execute the byte-code. 499a function to be called, Emacs uses the appropriate interpreter to
500execute either the byte-code or the non-compiled Lisp code.
500 501
501 Internally, a byte-code function object is much like a vector; its 502 Internally, a closure is much like a vector; its
502elements can be accessed using @code{aref}. Its printed 503elements can be accessed using @code{aref}. Its printed
503representation is like that for a vector, with an additional @samp{#} 504representation is like that for a vector, with an additional @samp{#}
504before the opening @samp{[}. It must have at least four elements; 505before the opening @samp{[}. It must have at least three elements;
505there is no maximum number, but only the first six elements have any 506there is no maximum number, but only the first six elements have any
506normal use. They are: 507normal use. They are:
507 508
@@ -515,20 +516,28 @@ zero to 6, and the maximum number of arguments in bits 8 to 14. If
515the argument list uses @code{&rest}, then bit 7 is set; otherwise it's 516the argument list uses @code{&rest}, then bit 7 is set; otherwise it's
516cleared. 517cleared.
517 518
518If @var{argdesc} is a list, the arguments will be dynamically bound 519When the closure is a byte-code function,
520if @var{argdesc} is a list, the arguments will be dynamically bound
519before executing the byte code. If @var{argdesc} is an integer, the 521before executing the byte code. If @var{argdesc} is an integer, the
520arguments will be instead pushed onto the stack of the byte-code 522arguments will be instead pushed onto the stack of the byte-code
521interpreter, before executing the code. 523interpreter, before executing the code.
522 524
523@item byte-code 525@item code
524The string containing the byte-code instructions. 526For interpreted functions, this element is the (non-empty) list of Lisp
527forms that make up the function's body. For byte-compiled functions, it
528is the string containing the byte-code instructions.
525 529
526@item constants 530@item constants
527The vector of Lisp objects referenced by the byte code. These include 531For byte-compiled functions, this holds the vector of Lisp objects
528symbols used as function names and variable names. 532referenced by the byte code. These include symbols used as function
533names and variable names.
534For interpreted functions, this is @code{nil} if the function is using the old
535dynamically scoped dialect of Emacs Lisp, and otherwise it holds the
536function's lexical environment.
529 537
530@item stacksize 538@item stacksize
531The maximum stack size this function needs. 539The maximum stack size this function needs. This element is left unused
540for interpreted functions.
532 541
533@item docstring 542@item docstring
534The documentation string (if any); otherwise, @code{nil}. The value may 543The documentation string (if any); otherwise, @code{nil}. The value may
@@ -558,8 +567,8 @@ representation. It is the definition of the command
558@code{make-byte-code}: 567@code{make-byte-code}:
559 568
560@defun make-byte-code &rest elements 569@defun make-byte-code &rest elements
561This function constructs and returns a byte-code function object 570This function constructs and returns a closure which represents the
562with @var{elements} as its elements. 571byte-code function object with @var{elements} as its elements.
563@end defun 572@end defun
564 573
565 You should not try to come up with the elements for a byte-code 574 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
567when you call the function. Always leave it to the byte compiler to 576when you call the function. Always leave it to the byte compiler to
568create these objects; it makes the elements consistent (we hope). 577create these objects; it makes the elements consistent (we hope).
569 578
579The primitive way to create an interpreted function is with
580@code{make-interpreted-closure}:
581
582@defun make-interpreted-closure args body env &optional docstring iform
583This function constructs and returns a closure representing the
584interpreted function with arguments @var{args} and whose body is made of
585@var{body} which must be a non-@code{nil} list of Lisp forms. @var{env} is the
586lexical environment in the same form as used with @code{eval}
587(@pxref{Eval}). The documentation @var{docstring} if non-@code{nil} should be
588a string, and the interactive form @var{iform} if non-@code{nil} should be of
589the form @w{@code{(interactive @var{arg-descriptor})}} (@pxref{Using
590Interactive}).
591@end defun
592
570@node Disassembly 593@node Disassembly
571@section Disassembled Byte-Code 594@section Disassembled Byte-Code
572@cindex disassembled byte-code 595@cindex disassembled byte-code
@@ -595,7 +618,7 @@ name of an existing buffer. Then the output goes there, at point, and
595point is left before the output. 618point is left before the output.
596 619
597The argument @var{object} can be a function name, a lambda expression 620The argument @var{object} can be a function name, a lambda expression
598(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Byte-Code 621(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Closure
599Objects}). If it is a lambda expression, @code{disassemble} compiles 622Objects}). If it is a lambda expression, @code{disassemble} compiles
600it and disassembles the resulting compiled code. 623it and disassembles the resulting compiled code.
601@end deffn 624@end deffn
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index f9f3389c398..46024e2fdee 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -2411,7 +2411,7 @@ point where we signaled the original error:
2411@group 2411@group
2412Debugger entered--Lisp error: (error "Oops") 2412Debugger entered--Lisp error: (error "Oops")
2413 signal(error ("Oops")) 2413 signal(error ("Oops"))
2414 (closure (t) (err) (signal 'error (cdr err)))((user-error "Oops")) 2414 #f(lambda (err) [t] (signal 'error (cdr err)))((user-error "Oops"))
2415 user-error("Oops") 2415 user-error("Oops")
2416 @dots{} 2416 @dots{}
2417 eval((handler-bind ((user-error (lambda (err) @dots{} 2417 eval((handler-bind ((user-error (lambda (err) @dots{}
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index ec93a0b9c8a..339272d1f05 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -323,7 +323,7 @@ Programming Types
323* Macro Type:: A method of expanding an expression into another 323* Macro Type:: A method of expanding an expression into another
324 expression, more fundamental but less pretty. 324 expression, more fundamental but less pretty.
325* Primitive Function Type:: A function written in C, callable from Lisp. 325* Primitive Function Type:: A function written in C, callable from Lisp.
326* Byte-Code Type:: A function written in Lisp, then compiled. 326* Closure Type:: A function written in Lisp, then compiled.
327* Record Type:: Compound objects with programmer-defined types. 327* Record Type:: Compound objects with programmer-defined types.
328* Type Descriptors:: Objects holding information about types. 328* Type Descriptors:: Objects holding information about types.
329* Autoload Type:: A type used for automatically loading seldom-used 329* Autoload Type:: A type used for automatically loading seldom-used
@@ -657,7 +657,7 @@ Byte Compilation
657* Docs and Compilation:: Dynamic loading of documentation strings. 657* Docs and Compilation:: Dynamic loading of documentation strings.
658* Eval During Compile:: Code to be evaluated when you compile. 658* Eval During Compile:: Code to be evaluated when you compile.
659* Compiler Errors:: Handling compiler error messages. 659* Compiler Errors:: Handling compiler error messages.
660* Byte-Code Objects:: The data type used for byte-compiled functions. 660* Closure Objects:: The data type used for byte-compiled functions.
661* Disassembly:: Disassembling byte-code; how to read byte-code. 661* Disassembly:: Disassembling byte-code; how to read byte-code.
662 662
663Native Compilation 663Native Compilation
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index ff635fc54b2..c57de08460f 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -130,7 +130,7 @@ it also encloses an environment of lexical variable bindings.
130 130
131@item byte-code function 131@item byte-code function
132A function that has been compiled by the byte compiler. 132A function that has been compiled by the byte compiler.
133@xref{Byte-Code Type}. 133@xref{Closure Type}.
134 134
135@item autoload object 135@item autoload object
136@cindex autoload object 136@cindex autoload object
@@ -227,6 +227,16 @@ Compilation}), or natively-compiled (@pxref{Native Compilation}), or
227a function loaded from a dynamic module (@pxref{Dynamic Modules}). 227a function loaded from a dynamic module (@pxref{Dynamic Modules}).
228@end defun 228@end defun
229 229
230@defun interpreted-function-p object
231This function returns @code{t} if @var{object} is an interpreted function.
232@end defun
233
234@defun closurep object
235This function returns @code{t} if @var{object} is a closure, which is
236a particular kind of function object. Currently closures are used
237for all byte-code functions and all interpreted functions.
238@end defun
239
230@defun subr-arity subr 240@defun subr-arity subr
231This works like @code{func-arity}, but only for built-in functions and 241This works like @code{func-arity}, but only for built-in functions and
232without symbol indirection. It signals an error for non-built-in 242without symbol indirection. It signals an error for non-built-in
@@ -1136,8 +1146,7 @@ Functions}). @xref{describe-symbols example}, for a realistic example
1136of this. 1146of this.
1137 1147
1138 When defining a lambda expression that is to be used as an anonymous 1148 When defining a lambda expression that is to be used as an anonymous
1139function, you can in principle use any method to construct the list. 1149function, you should use the @code{lambda} macro, or the
1140But typically you should use the @code{lambda} macro, or the
1141@code{function} special form, or the @code{#'} read syntax: 1150@code{function} special form, or the @code{#'} read syntax:
1142 1151
1143@defmac lambda args [doc] [interactive] body@dots{} 1152@defmac lambda args [doc] [interactive] body@dots{}
@@ -1145,17 +1154,18 @@ This macro returns an anonymous function with argument list
1145@var{args}, documentation string @var{doc} (if any), interactive spec 1154@var{args}, documentation string @var{doc} (if any), interactive spec
1146@var{interactive} (if any), and body forms given by @var{body}. 1155@var{interactive} (if any), and body forms given by @var{body}.
1147 1156
1148Under dynamic binding, this macro effectively makes @code{lambda} 1157For example, this macro makes @code{lambda} forms almost self-quoting:
1149forms self-quoting: evaluating a form whose @sc{car} is @code{lambda} 1158evaluating a form whose @sc{car} is @code{lambda} yields a value that is
1150yields the form itself: 1159almost like the form itself:
1151 1160
1152@example 1161@example
1153(lambda (x) (* x x)) 1162(lambda (x) (* x x))
1154 @result{} (lambda (x) (* x x)) 1163 @result{} #f(lambda (x) :dynbind (* x x))
1155@end example 1164@end example
1156 1165
1157Note that when evaluating under lexical binding the result is a 1166When evaluating under lexical binding the result is a similar
1158closure object (@pxref{Closures}). 1167closure object, where the @code{:dynbind} marker is replaced by the
1168captured variables (@pxref{Closures}).
1159 1169
1160The @code{lambda} form has one other effect: it tells the Emacs 1170The @code{lambda} form has one other effect: it tells the Emacs
1161evaluator and byte-compiler that its argument is a function, by using 1171evaluator 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
1164 1174
1165@defspec function function-object 1175@defspec function function-object
1166@cindex function quoting 1176@cindex function quoting
1167This special form returns @var{function-object} without evaluating it. 1177This special form returns the function value of the @var{function-object}.
1168In this, it is similar to @code{quote} (@pxref{Quoting}). But unlike 1178In many ways, it is similar to @code{quote} (@pxref{Quoting}). But unlike
1169@code{quote}, it also serves as a note to the Emacs evaluator and 1179@code{quote}, it also serves as a note to the Emacs evaluator and
1170byte-compiler that @var{function-object} is intended to be used as a 1180byte-compiler that @var{function-object} is intended to be used as a
1171function. Assuming @var{function-object} is a valid lambda 1181function. Assuming @var{function-object} is a valid lambda
@@ -1495,7 +1505,7 @@ distinguish between a function cell that is void and one set to
1495@group 1505@group
1496(defun bar (n) (+ n 2)) 1506(defun bar (n) (+ n 2))
1497(symbol-function 'bar) 1507(symbol-function 'bar)
1498 @result{} (lambda (n) (+ n 2)) 1508 @result{} #f(lambda (n) [t] (+ n 2))
1499@end group 1509@end group
1500@group 1510@group
1501(fset 'baz 'bar) 1511(fset 'baz 'bar)
@@ -1608,7 +1618,7 @@ argument list and body forms as the remaining elements:
1608@example 1618@example
1609;; @r{lexical binding is enabled.} 1619;; @r{lexical binding is enabled.}
1610(lambda (x) (* x x)) 1620(lambda (x) (* x x))
1611 @result{} (closure (t) (x) (* x x)) 1621 @result{} #f(lambda (x) [t] (* x x))
1612@end example 1622@end example
1613 1623
1614@noindent 1624@noindent
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 1409e51c0d4..06472539744 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1249,7 +1249,7 @@ this is not guaranteed to happen):
1249 1249
1250@group 1250@group
1251(symbol-function 'add-foo) 1251(symbol-function 'add-foo)
1252 @result{} (lambda (x) (nconc '(foo) x)) 1252 @result{} #f(lambda (x) [t] (nconc '(foo) x))
1253@end group 1253@end group
1254 1254
1255@group 1255@group
@@ -1267,7 +1267,7 @@ this is not guaranteed to happen):
1267 1267
1268@group 1268@group
1269(symbol-function 'add-foo) 1269(symbol-function 'add-foo)
1270 @result{} (lambda (x) (nconc '(foo 1 2 3 4) x)) 1270 @result{} #f(lambda (x) [t] (nconc '(foo 1 2 3 4) x))
1271@end group 1271@end group
1272@end smallexample 1272@end smallexample
1273@end defun 1273@end defun
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index aa1e073042f..cf703aba9c8 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -244,7 +244,7 @@ latter are unique to Emacs Lisp.
244* Macro Type:: A method of expanding an expression into another 244* Macro Type:: A method of expanding an expression into another
245 expression, more fundamental but less pretty. 245 expression, more fundamental but less pretty.
246* Primitive Function Type:: A function written in C, callable from Lisp. 246* Primitive Function Type:: A function written in C, callable from Lisp.
247* Byte-Code Type:: A function written in Lisp, then compiled. 247* Closure Type:: A function written in Lisp.
248* Record Type:: Compound objects with programmer-defined types. 248* Record Type:: Compound objects with programmer-defined types.
249* Type Descriptors:: Objects holding information about types. 249* Type Descriptors:: Objects holding information about types.
250* Autoload Type:: A type used for automatically loading seldom-used 250* Autoload Type:: A type used for automatically loading seldom-used
@@ -1458,18 +1458,24 @@ with the name of the subroutine.
1458@end group 1458@end group
1459@end example 1459@end example
1460 1460
1461@node Byte-Code Type 1461@node Closure Type
1462@subsection Byte-Code Function Type 1462@subsection Closure Function Type
1463 1463
1464@dfn{Byte-code function objects} are produced by byte-compiling Lisp 1464@dfn{Closures} are function objects produced when turning a function
1465code (@pxref{Byte Compilation}). Internally, a byte-code function 1465definition into a function value. Closures are used both for
1466object is much like a vector; however, the evaluator handles this data 1466byte-compiled Lisp functions as well as for interpreted Lisp functions.
1467type specially when it appears in a function call. @xref{Byte-Code 1467Closures can be produced by byte-compiling Lisp code (@pxref{Byte
1468Objects}. 1468Compilation}) or simply by evaluating a lambda expression without
1469compiling it, resulting in an interpreted function. Internally,
1470a closure is much like a vector; however, the evaluator
1471handles this data type specially when it appears in a function call.
1472@xref{Closure Objects}.
1469 1473
1470The printed representation and read syntax for a byte-code function 1474The printed representation and read syntax for a byte-code function
1471object is like that for a vector, with an additional @samp{#} before the 1475object is like that for a vector, with an additional @samp{#} before the
1472opening @samp{[}. 1476opening @samp{[}. When printed for human consumption, it is printed as
1477a special kind of list with an additional @samp{#f} before the opening
1478@samp{(}.
1473 1479
1474@node Record Type 1480@node Record Type
1475@subsection Record Type 1481@subsection Record Type
@@ -2042,10 +2048,7 @@ with references to further information.
2042@xref{Buffer Basics, bufferp}. 2048@xref{Buffer Basics, bufferp}.
2043 2049
2044@item byte-code-function-p 2050@item byte-code-function-p
2045@xref{Byte-Code Type, byte-code-function-p}. 2051@xref{Closure Type, byte-code-function-p}.
2046
2047@item compiled-function-p
2048@xref{Byte-Code Type, compiled-function-p}.
2049 2052
2050@item case-table-p 2053@item case-table-p
2051@xref{Case Tables, case-table-p}. 2054@xref{Case Tables, case-table-p}.
@@ -2056,9 +2059,15 @@ with references to further information.
2056@item char-table-p 2059@item char-table-p
2057@xref{Char-Tables, char-table-p}. 2060@xref{Char-Tables, char-table-p}.
2058 2061
2062@item closurep
2063@xref{What Is a Function, closurep}.
2064
2059@item commandp 2065@item commandp
2060@xref{Interactive Call, commandp}. 2066@xref{Interactive Call, commandp}.
2061 2067
2068@item compiled-function-p
2069@xref{Closure Type, compiled-function-p}.
2070
2062@item condition-variable-p 2071@item condition-variable-p
2063@xref{Condition Variables, condition-variable-p}. 2072@xref{Condition Variables, condition-variable-p}.
2064 2073
@@ -2098,6 +2107,9 @@ with references to further information.
2098@item integerp 2107@item integerp
2099@xref{Predicates on Numbers, integerp}. 2108@xref{Predicates on Numbers, integerp}.
2100 2109
2110@item interpreted-function-p
2111@xref{What Is a Function, interpreted-function-p}.
2112
2101@item keymapp 2113@item keymapp
2102@xref{Creating Keymaps, keymapp}. 2114@xref{Creating Keymaps, keymapp}.
2103 2115
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index c9e47624878..4c5525f10c5 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1583,7 +1583,7 @@ nonempty vector that is not @code{eq} to any existing vector.
1583 1583
1584The @code{vconcat} function also allows byte-code function objects as 1584The @code{vconcat} function also allows byte-code function objects as
1585arguments. This is a special feature to make it easy to access the entire 1585arguments. This is a special feature to make it easy to access the entire
1586contents of a byte-code function object. @xref{Byte-Code Objects}. 1586contents of a byte-code function object. @xref{Closure Objects}.
1587 1587
1588For other concatenation functions, see @code{mapconcat} in @ref{Mapping 1588For other concatenation functions, see @code{mapconcat} in @ref{Mapping
1589Functions}, @code{concat} in @ref{Creating Strings}, and @code{append} 1589Functions}, @code{concat} in @ref{Creating Strings}, and @code{append}
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 4d61d461deb..16b6b52e5f1 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1079,7 +1079,7 @@ Here is an example:
1079(let ((x 0)) ; @r{@code{x} is lexically bound.} 1079(let ((x 0)) ; @r{@code{x} is lexically bound.}
1080 (setq my-ticker (lambda () 1080 (setq my-ticker (lambda ()
1081 (setq x (1+ x))))) 1081 (setq x (1+ x)))))
1082 @result{} (closure ((x . 0)) () 1082 @result{} #f(lambda () [(x 0)]
1083 (setq x (1+ x))) 1083 (setq x (1+ x)))
1084 1084
1085(funcall my-ticker) 1085(funcall my-ticker)
diff --git a/etc/NEWS b/etc/NEWS
index 78a1307b6a4..7c390d43fa3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1741,6 +1741,23 @@ documentation and examples.
1741* Incompatible Lisp Changes in Emacs 30.1 1741* Incompatible Lisp Changes in Emacs 30.1
1742 1742
1743+++ 1743+++
1744** Evaluating a 'lambda' returns an object of type 'interpreted-function'.
1745Instead of representing interpreted functions as lists that start with
1746either 'lambda' or 'closure', Emacs now represents them as objects
1747of their own 'interpreted-function' type, which is very similar
1748to 'byte-code-function' objects (the argument list, docstring, and
1749interactive forms are placed in the same slots).
1750Lists that start with 'lambda' are now used only for non-evaluated
1751functions (in other words, for source code), but for backward compatibility
1752reasons, 'functionp' still recognizes them as functions and you can
1753still call them as before.
1754Thus code that attempts to "dig" into the internal structure of an
1755interpreted function's object with the likes of 'car' or 'cdr' will
1756no longer work and will need to use 'aref' used instead to extract its
1757various subparts (when 'interactive-form', 'documentation', and
1758'help-function-arglist' aren't adequate).
1759
1760+++
1744** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'. 1761** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'.
1745Minor modes defined with 'define-globalized-minor-mode', such as 1762Minor modes defined with 'define-globalized-minor-mode', such as
1746'global-font-lock-mode', will not be enabled any more in those buffers 1763'global-font-lock-mode', will not be enabled any more in those buffers
@@ -1879,6 +1896,14 @@ unibyte string.
1879 1896
1880* Lisp Changes in Emacs 30.1 1897* Lisp Changes in Emacs 30.1
1881 1898
1899** New types 'closure' and 'interpreted-function'.
1900'interpreted-function' is the new type used for interpreted functions,
1901and 'closure' is the common parent type of 'interpreted-function'
1902and 'byte-code-function'.
1903Those new types come with the associated new predicates
1904'closurep' and `interpreted-function-p' as well as a new constructor
1905'make-interpreted-closure'.
1906
1882** New function 'help-fns-function-name'. 1907** New function 'help-fns-function-name'.
1883For named functions, it just returns the name and otherwise 1908For named functions, it just returns the name and otherwise
1884it returns a short "unique" string that identifies the function. 1909it returns a short "unique" string that identifies the function.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index ea163723a3e..3d6b35422b8 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -164,7 +164,7 @@ Earlier variables shadow later ones with the same name.")
164 ;; The byte-code will be really inlined in byte-compile-unfold-bcf. 164 ;; The byte-code will be really inlined in byte-compile-unfold-bcf.
165 (byte-compile--check-arity-bytecode form fn) 165 (byte-compile--check-arity-bytecode form fn)
166 `(,fn ,@(cdr form))) 166 `(,fn ,@(cdr form)))
167 ((or `(lambda . ,_) `(closure . ,_)) 167 ((pred interpreted-function-p)
168 ;; While byte-compile-unfold-bcf can inline dynbind byte-code into 168 ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
169 ;; letbind byte-code (or any other combination for that matter), we 169 ;; letbind byte-code (or any other combination for that matter), we
170 ;; can only inline dynbind source into dynbind source or lexbind 170 ;; can only inline dynbind source into dynbind source or lexbind
@@ -1870,6 +1870,7 @@ See Info node `(elisp) Integer Basics'."
1870 charsetp 1870 charsetp
1871 ;; data.c 1871 ;; data.c
1872 arrayp atom bare-symbol-p bool-vector-p bufferp byte-code-function-p 1872 arrayp atom bare-symbol-p bool-vector-p bufferp byte-code-function-p
1873 interpreted-function-p closurep
1873 byteorder car-safe cdr-safe char-or-string-p char-table-p 1874 byteorder car-safe cdr-safe char-or-string-p char-table-p
1874 condition-variable-p consp eq floatp indirect-function 1875 condition-variable-p consp eq floatp indirect-function
1875 integer-or-marker-p integerp keywordp listp markerp 1876 integer-or-marker-p integerp keywordp listp markerp
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index fb3278c08ab..59aa9098768 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2900,9 +2900,14 @@ otherwise, print without quoting."
2900(defun byte-compile--reify-function (fun) 2900(defun byte-compile--reify-function (fun)
2901 "Return an expression which will evaluate to a function value FUN. 2901 "Return an expression which will evaluate to a function value FUN.
2902FUN should be an interpreted closure." 2902FUN should be an interpreted closure."
2903 (pcase-let* ((`(closure ,env ,args . ,body) fun) 2903 (let* ((args (aref fun 0))
2904 (`(,preamble . ,body) (macroexp-parse-body body)) 2904 (body (aref fun 1))
2905 (renv ())) 2905 (env (aref fun 2))
2906 (docstring (function-documentation fun))
2907 (iform (interactive-form fun))
2908 (preamble `(,@(if docstring (list docstring))
2909 ,@(if iform (list iform))))
2910 (renv ()))
2906 ;; Turn the function's closed vars (if any) into local let bindings. 2911 ;; Turn the function's closed vars (if any) into local let bindings.
2907 (dolist (binding env) 2912 (dolist (binding env)
2908 (cond 2913 (cond
@@ -2939,11 +2944,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2939 (if (symbolp form) form "provided")) 2944 (if (symbolp form) form "provided"))
2940 fun) 2945 fun)
2941 (t 2946 (t
2942 (when (or (symbolp form) (eq (car-safe fun) 'closure)) 2947 (when (or (symbolp form) (interpreted-function-p fun))
2943 ;; `fun' is a function *value*, so try to recover its 2948 ;; `fun' is a function *value*, so try to recover its
2944 ;; corresponding source code. 2949 ;; corresponding source code.
2945 (when (setq lexical-binding (eq (car-safe fun) 'closure)) 2950 (setq lexical-binding (not (null (aref fun 2))))
2946 (setq fun (byte-compile--reify-function fun))) 2951 (setq fun (byte-compile--reify-function fun))
2947 (setq need-a-value t)) 2952 (setq need-a-value t))
2948 ;; Expand macros. 2953 ;; Expand macros.
2949 (setq fun (byte-compile-preprocess fun)) 2954 (setq fun (byte-compile-preprocess fun))
@@ -5133,7 +5138,6 @@ binding slots have been popped."
5133 ;; `arglist' is the list of arguments (or t if not recognized). 5138 ;; `arglist' is the list of arguments (or t if not recognized).
5134 ;; `body' is the body of `lam' (or t if not recognized). 5139 ;; `body' is the body of `lam' (or t if not recognized).
5135 ((or `(lambda ,arglist . ,body) 5140 ((or `(lambda ,arglist . ,body)
5136 ;; `(closure ,_ ,arglist . ,body)
5137 (and `(internal-make-closure ,arglist . ,_) (let body t)) 5141 (and `(internal-make-closure ,arglist . ,_) (let body t))
5138 (and (let arglist t) (let body t))) 5142 (and (let arglist t) (let body t)))
5139 lam)) 5143 lam))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 4ff47971351..e6a78f07762 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -902,7 +902,7 @@ lexically and dynamically bound symbols actually used by FORM."
902 (delete-dups cconv--dynbindings))))) 902 (delete-dups cconv--dynbindings)))))
903 (cons fvs dyns))))) 903 (cons fvs dyns)))))
904 904
905(defun cconv-make-interpreted-closure (fun env) 905(defun cconv-make-interpreted-closure (args body env docstring iform)
906 "Make a closure for the interpreter. 906 "Make a closure for the interpreter.
907This is intended to be called at runtime by the ELisp interpreter (when 907This is intended to be called at runtime by the ELisp interpreter (when
908the code has not been compiled). 908the code has not been compiled).
@@ -911,22 +911,27 @@ ENV is the runtime representation of the lexical environment,
911i.e. a list whose elements can be either plain symbols (which indicate 911i.e. a list whose elements can be either plain symbols (which indicate
912that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE) 912that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE)
913for the lexical bindings." 913for the lexical bindings."
914 (cl-assert (eq (car-safe fun) 'lambda)) 914 (cl-assert (consp body))
915 (cl-assert (listp args))
915 (let ((lexvars (delq nil (mapcar #'car-safe env)))) 916 (let ((lexvars (delq nil (mapcar #'car-safe env))))
916 (if (or (null lexvars) 917 (if (or
917 ;; Functions with a `:closure-dont-trim-context' marker 918 ;; Functions with a `:closure-dont-trim-context' marker
918 ;; should keep their whole context untrimmed (bug#59213). 919 ;; should keep their whole context untrimmed (bug#59213).
919 (and (eq :closure-dont-trim-context (nth 2 fun)) 920 (and (eq :closure-dont-trim-context (car body))
920 ;; Check the function doesn't just return the magic keyword. 921 ;; Check the function doesn't just return the magic keyword.
921 (nthcdr 3 fun))) 922 (cdr body)
923 ;; Drop the magic marker from the closure.
924 (setq body (cdr body)))
925 ;; There's no var to capture, so skip the analysis.
926 (null lexvars))
922 ;; The lexical environment is empty, or needs to be preserved, 927 ;; The lexical environment is empty, or needs to be preserved,
923 ;; so there's no need to look for free variables. 928 ;; so there's no need to look for free variables.
924 ;; Attempting to replace ,(cdr fun) by a macroexpanded version 929 ;; Attempting to replace body by a macroexpanded version
925 ;; causes bootstrap to fail. 930 ;; caused bootstrap to fail.
926 `(closure ,env . ,(cdr fun)) 931 (make-interpreted-closure args body env docstring iform)
927 ;; We could try and cache the result of the macroexpansion and 932 ;; We could try and cache the result of the macroexpansion and
928 ;; `cconv-fv' analysis. Not sure it's worth the trouble. 933 ;; `cconv-fv' analysis. Not sure it's worth the trouble.
929 (let* ((form `#',fun) 934 (let* ((form `#'(lambda ,args ,iform . ,body))
930 (expanded-form 935 (expanded-form
931 (let ((lexical-binding t) ;; Tell macros which dialect is in use. 936 (let ((lexical-binding t) ;; Tell macros which dialect is in use.
932 ;; Make the macro aware of any defvar declarations in scope. 937 ;; Make the macro aware of any defvar declarations in scope.
@@ -935,10 +940,10 @@ for the lexical bindings."
935 (append env macroexp--dynvars) env))) 940 (append env macroexp--dynvars) env)))
936 (macroexpand-all form macroexpand-all-environment))) 941 (macroexpand-all form macroexpand-all-environment)))
937 ;; Since we macroexpanded the body, we may as well use that. 942 ;; Since we macroexpanded the body, we may as well use that.
938 (expanded-fun-cdr 943 (expanded-fun-body
939 (pcase expanded-form 944 (pcase expanded-form
940 (`#'(lambda . ,cdr) cdr) 945 (`#'(lambda ,_args ,_iform . ,newbody) newbody)
941 (_ (cdr fun)))) 946 (_ body)))
942 947
943 (dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env))) 948 (dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
944 (fvs (cconv-fv expanded-form lexvars dynvars)) 949 (fvs (cconv-fv expanded-form lexvars dynvars))
@@ -946,7 +951,8 @@ for the lexical bindings."
946 (cdr fvs)))) 951 (cdr fvs))))
947 ;; Never return a nil env, since nil means to use the dynbind 952 ;; Never return a nil env, since nil means to use the dynbind
948 ;; dialect of ELisp. 953 ;; dialect of ELisp.
949 `(closure ,(or newenv '(t)) . ,expanded-fun-cdr))))) 954 (make-interpreted-closure args expanded-fun-body (or newenv '(t))
955 docstring iform)))))
950 956
951 957
952(provide 'cconv) 958(provide 'cconv)
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 83d9e6ee220..fa745396b02 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -444,13 +444,24 @@ For this build of Emacs it's %dbit."
444 ) 444 )
445(cl--define-built-in-type compiled-function (function) 445(cl--define-built-in-type compiled-function (function)
446 "Abstract type of functions that have been compiled.") 446 "Abstract type of functions that have been compiled.")
447(cl--define-built-in-type byte-code-function (compiled-function) 447(cl--define-built-in-type closure (function)
448 "Abstract type of functions represented by a vector-like object.
449You can access the object's internals with `aref'.
450The fields are used as follows:
451
452 0 [args] Argument list (either a list or an integer)
453 1 [code] Either a byte-code string or a list of Lisp forms
454 2 [constants] Either vector of constants or a lexical environment
455 3 [stackdepth] Maximum amount of stack depth used by the byte-code
456 4 [docstring] The documentation, or a reference to it
457 5 [iform] The interactive form (if present)")
458(cl--define-built-in-type byte-code-function (compiled-function closure)
448 "Type of functions that have been byte-compiled.") 459 "Type of functions that have been byte-compiled.")
449(cl--define-built-in-type subr (atom) 460(cl--define-built-in-type subr (atom)
450 "Abstract type of functions compiled to machine code.") 461 "Abstract type of functions compiled to machine code.")
451(cl--define-built-in-type module-function (function) 462(cl--define-built-in-type module-function (function)
452 "Type of functions provided via the module API.") 463 "Type of functions provided via the module API.")
453(cl--define-built-in-type interpreted-function (function) 464(cl--define-built-in-type interpreted-function (closure)
454 "Type of functions that have not been compiled.") 465 "Type of functions that have not been compiled.")
455(cl--define-built-in-type special-form (subr) 466(cl--define-built-in-type special-form (subr)
456 "Type of the core syntactic elements of the Emacs Lisp language.") 467 "Type of the core syntactic elements of the Emacs Lisp language.")
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 5e5eee1da9e..3a8f80f6e93 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -237,6 +237,38 @@ into a button whose action shows the function's disassembly.")
237 'byte-code-function object))))) 237 'byte-code-function object)))))
238 (princ ")" stream))) 238 (princ ")" stream)))
239 239
240(cl-defmethod cl-print-object ((object interpreted-function) stream)
241 (unless stream (setq stream standard-output))
242 (princ "#f(lambda " stream)
243 (let ((args (help-function-arglist object 'preserve-names)))
244 ;; It's tempting to print the arglist from the "usage" info in the
245 ;; doc (e.g. for `&key` args), but that only makes sense if we
246 ;; *don't* print the body, since otherwise the body will tend to
247 ;; refer to args that don't appear in the arglist.
248 (if args
249 (prin1 args stream)
250 (princ "()" stream)))
251 (let ((env (aref object 2)))
252 (if (null env)
253 (princ " :dynbind" stream)
254 (princ " " stream)
255 (cl-print-object
256 (vconcat (mapcar (lambda (x) (if (consp x) (list (car x) (cdr x)) x))
257 env))
258 stream)))
259 (let* ((doc (documentation object 'raw)))
260 (when doc
261 (princ " " stream)
262 (prin1 doc stream)))
263 (let ((inter (interactive-form object)))
264 (when inter
265 (princ " " stream)
266 (cl-print-object inter stream)))
267 (dolist (exp (aref object 1))
268 (princ " " stream)
269 (cl-print-object exp stream))
270 (princ ")" stream))
271
240;; This belongs in oclosure.el, of course, but some load-ordering issues make it 272;; This belongs in oclosure.el, of course, but some load-ordering issues make it
241;; complicated. 273;; complicated.
242(cl-defmethod cl-print-object ((object accessor) stream) 274(cl-defmethod cl-print-object ((object accessor) stream)
diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el
index 4edfe811586..62fd28f772e 100644
--- a/lisp/emacs-lisp/comp-common.el
+++ b/lisp/emacs-lisp/comp-common.el
@@ -118,7 +118,9 @@ Used to modify the compiler environment."
118 (buffer-substring 118 (buffer-substring
119 (function ((or integer marker) (or integer marker)) string)) 119 (function ((or integer marker) (or integer marker)) string))
120 (bufferp (function (t) boolean)) 120 (bufferp (function (t) boolean))
121 (closurep (function (t) boolean))
121 (byte-code-function-p (function (t) boolean)) 122 (byte-code-function-p (function (t) boolean))
123 (interpreted-function-p (function (t) boolean))
122 (capitalize (function ((or integer string)) (or integer string))) 124 (capitalize (function ((or integer string)) (or integer string)))
123 (car (function (list) t)) 125 (car (function (list) t))
124 (car-less-than-car (function (list list) boolean)) 126 (car-less-than-car (function (list list) boolean))
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 850cc2085f7..15caee9b29c 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -129,7 +129,7 @@ redefine OBJECT if it is a symbol."
129 (setq args (help-function-arglist obj)) ;save arg list 129 (setq args (help-function-arglist obj)) ;save arg list
130 (setq obj (cdr obj)) ;throw lambda away 130 (setq obj (cdr obj)) ;throw lambda away
131 (setq obj (cdr obj))) 131 (setq obj (cdr obj)))
132 ((byte-code-function-p obj) 132 ((closurep obj)
133 (setq args (help-function-arglist obj))) 133 (setq args (help-function-arglist obj)))
134 (t (error "Compilation failed"))) 134 (t (error "Compilation failed")))
135 (if (zerop indent) ; not a nested function 135 (if (zerop indent) ; not a nested function
@@ -178,7 +178,9 @@ redefine OBJECT if it is a symbol."
178 (t 178 (t
179 (insert "Uncompiled body: ") 179 (insert "Uncompiled body: ")
180 (let ((print-escape-newlines t)) 180 (let ((print-escape-newlines t))
181 (prin1 (macroexp-progn obj) 181 (prin1 (macroexp-progn (if (interpreted-function-p obj)
182 (aref obj 1)
183 obj))
182 (current-buffer)))))) 184 (current-buffer))))))
183 (if interactive-p 185 (if interactive-p
184 (message ""))) 186 (message "")))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index b27ffbca908..3414bb592c0 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -4254,7 +4254,7 @@ code location is known."
4254 ((pred edebug--symbol-prefixed-p) nil) 4254 ((pred edebug--symbol-prefixed-p) nil)
4255 (_ 4255 (_
4256 (when (and skip-next-lambda 4256 (when (and skip-next-lambda
4257 (not (memq (car-safe fun) '(closure lambda)))) 4257 (not (interpreted-function-p fun)))
4258 (warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun)) 4258 (warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun))
4259 (unless skip-next-lambda 4259 (unless skip-next-lambda
4260 (edebug--unwrap-frame new-frame) 4260 (edebug--unwrap-frame new-frame)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 3475d944337..601cc7bf712 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1347,7 +1347,6 @@ Lisp function does not specify a special indentation."
1347(put 'condition-case 'lisp-indent-function 2) 1347(put 'condition-case 'lisp-indent-function 2)
1348(put 'handler-case 'lisp-indent-function 1) ;CL 1348(put 'handler-case 'lisp-indent-function 1) ;CL
1349(put 'unwind-protect 'lisp-indent-function 1) 1349(put 'unwind-protect 'lisp-indent-function 1)
1350(put 'closure 'lisp-indent-function 2)
1351 1350
1352(defun indent-sexp (&optional endpos) 1351(defun indent-sexp (&optional endpos)
1353 "Indent each line of the list starting just after point. 1352 "Indent each line of the list starting just after point.
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 5326c520601..36df143a82a 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -185,7 +185,7 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
185(defun advice--interactive-form-1 (function) 185(defun advice--interactive-form-1 (function)
186 "Like `interactive-form' but preserves the static context if needed." 186 "Like `interactive-form' but preserves the static context if needed."
187 (let ((if (interactive-form function))) 187 (let ((if (interactive-form function)))
188 (if (or (null if) (not (eq 'closure (car-safe function)))) 188 (if (not (and if (interpreted-function-p function)))
189 if 189 if
190 (cl-assert (eq 'interactive (car if))) 190 (cl-assert (eq 'interactive (car if)))
191 (let ((form (cadr if))) 191 (let ((form (cadr if)))
@@ -193,14 +193,14 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
193 if 193 if
194 ;; The interactive is expected to be run in the static context 194 ;; The interactive is expected to be run in the static context
195 ;; that the function captured. 195 ;; that the function captured.
196 (let ((ctx (nth 1 function))) 196 (let ((ctx (aref function 2)))
197 `(interactive 197 `(interactive
198 ,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form))) 198 ,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form)))
199 ;; If the form jut returns a function, preserve the fact that 199 ;; If the form jut returns a function, preserve the fact that
200 ;; it just returns a function, which is an info we use in 200 ;; it just returns a function, which is an info we use in
201 ;; `advice--make-interactive-form'. 201 ;; `advice--make-interactive-form'.
202 (if (eq 'lambda (car-safe f)) 202 (if (eq 'lambda (car-safe f))
203 `',(eval form ctx) 203 (eval form ctx)
204 `(eval ',form ',ctx)))))))))) 204 `(eval ',form ',ctx))))))))))
205 205
206(defun advice--interactive-form (function) 206(defun advice--interactive-form (function)
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 4da8e61aaa7..165d7c4b6e8 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -146,7 +146,7 @@
146(setf (cl--find-class 'oclosure) 146(setf (cl--find-class 'oclosure)
147 (oclosure--class-make 'oclosure 147 (oclosure--class-make 'oclosure
148 "The root parent of all OClosure types" 148 "The root parent of all OClosure types"
149 nil (list (cl--find-class 'function)) 149 nil (list (cl--find-class 'closure))
150 '(oclosure))) 150 '(oclosure)))
151(defun oclosure--p (oclosure) 151(defun oclosure--p (oclosure)
152 (not (not (oclosure-type oclosure)))) 152 (not (not (oclosure-type oclosure))))
@@ -431,75 +431,57 @@ ARGS and BODY are the same as for `lambda'."
431 431
432(defun oclosure--fix-type (_ignore oclosure) 432(defun oclosure--fix-type (_ignore oclosure)
433 "Helper function to implement `oclosure-lambda' via a macro. 433 "Helper function to implement `oclosure-lambda' via a macro.
434This has 2 uses: 434This is used as a marker which cconv uses to check that
435- For interpreted code, this converts the representation of type information 435immutable fields are indeed not mutated."
436 by moving it from the docstring to the environment. 436 (cl-assert (closurep oclosure))
437- For compiled code, this is used as a marker which cconv uses to check that 437 ;; This should happen only for interpreted closures since `cconv.el'
438 immutable fields are indeed not mutated." 438 ;; should have optimized away the call to this function.
439 (if (byte-code-function-p oclosure) 439 oclosure)
440 ;; Actually, this should never happen since `cconv.el' should have
441 ;; optimized away the call to this function.
442 oclosure
443 ;; For byte-coded functions, we store the type as a symbol in the docstring
444 ;; slot. For interpreted functions, there's no specific docstring slot
445 ;; so `Ffunction' turns the symbol into a string.
446 ;; We thus have convert it back into a symbol (via `intern') and then
447 ;; stuff it into the environment part of the closure with a special
448 ;; marker so we can distinguish this entry from actual variables.
449 (cl-assert (eq 'closure (car-safe oclosure)))
450 (let ((typename (nth 3 oclosure))) ;; The "docstring".
451 (cl-assert (stringp typename))
452 (push (cons :type (intern typename))
453 (cadr oclosure))
454 oclosure)))
455 440
456(defun oclosure--copy (oclosure mutlist &rest args) 441(defun oclosure--copy (oclosure mutlist &rest args)
442 (cl-assert (closurep oclosure))
457 (if (byte-code-function-p oclosure) 443 (if (byte-code-function-p oclosure)
458 (apply #'make-closure oclosure 444 (apply #'make-closure oclosure
459 (if (null mutlist) 445 (if (null mutlist)
460 args 446 args
461 (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args))) 447 (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
462 (cl-assert (eq 'closure (car-safe oclosure)) 448 (cl-assert (consp (aref oclosure 1)))
463 nil "oclosure not closure: %S" oclosure) 449 (cl-assert (null (aref oclosure 3)))
464 (cl-assert (eq :type (caar (cadr oclosure)))) 450 (cl-assert (symbolp (aref oclosure 4)))
465 (let ((env (cadr oclosure))) 451 (let ((env (aref oclosure 2)))
466 `(closure 452 (make-interpreted-closure
467 (,(car env) 453 (aref oclosure 0)
468 ,@(named-let loop ((env (cdr env)) (args args)) 454 (aref oclosure 1)
469 (when args 455 (named-let loop ((env env) (args args))
470 (cons (cons (caar env) (car args)) 456 (if (null args) env
471 (loop (cdr env) (cdr args))))) 457 (cons (cons (caar env) (car args))
472 ,@(nthcdr (1+ (length args)) env)) 458 (loop (cdr env) (cdr args)))))
473 ,@(nthcdr 2 oclosure))))) 459 (aref oclosure 4)
460 (if (> (length oclosure) 5)
461 `(interactive ,(aref oclosure 5)))))))
474 462
475(defun oclosure--get (oclosure index mutable) 463(defun oclosure--get (oclosure index mutable)
476 (if (byte-code-function-p oclosure) 464 (cl-assert (closurep oclosure))
477 (let* ((csts (aref oclosure 2)) 465 (let* ((csts (aref oclosure 2)))
478 (v (aref csts index))) 466 (if (vectorp csts)
479 (if mutable (car v) v)) 467 (let ((v (aref csts index)))
480 (cl-assert (eq 'closure (car-safe oclosure))) 468 (if mutable (car v) v))
481 (cl-assert (eq :type (caar (cadr oclosure)))) 469 (cdr (nth index csts)))))
482 (cdr (nth (1+ index) (cadr oclosure)))))
483 470
484(defun oclosure--set (v oclosure index) 471(defun oclosure--set (v oclosure index)
485 (if (byte-code-function-p oclosure) 472 (cl-assert (closurep oclosure))
486 (let* ((csts (aref oclosure 2)) 473 (let ((csts (aref oclosure 2)))
487 (cell (aref csts index))) 474 (if (vectorp csts)
488 (setcar cell v)) 475 (let ((cell (aref csts index)))
489 (cl-assert (eq 'closure (car-safe oclosure))) 476 (setcar cell v))
490 (cl-assert (eq :type (caar (cadr oclosure)))) 477 (setcdr (nth index csts) v))))
491 (setcdr (nth (1+ index) (cadr oclosure)) v)))
492 478
493(defun oclosure-type (oclosure) 479(defun oclosure-type (oclosure)
494 "Return the type of OCLOSURE, or nil if the arg is not a OClosure." 480 "Return the type of OCLOSURE, or nil if the arg is not an OClosure."
495 (if (byte-code-function-p oclosure) 481 (and (closurep oclosure)
496 (let ((type (and (> (length oclosure) 4) (aref oclosure 4)))) 482 (> (length oclosure) 4)
497 (if (symbolp type) type)) 483 (let ((type (aref oclosure 4)))
498 (and (eq 'closure (car-safe oclosure)) 484 (if (symbolp type) type))))
499 (let* ((env (car-safe (cdr oclosure)))
500 (first-var (car-safe env)))
501 (and (eq :type (car-safe first-var))
502 (cdr first-var))))))
503 485
504(defconst oclosure--accessor-prototype 486(defconst oclosure--accessor-prototype
505 ;; Use `oclosure--lambda' to circumvent a bootstrapping problem: 487 ;; Use `oclosure--lambda' to circumvent a bootstrapping problem:
diff --git a/lisp/help.el b/lisp/help.el
index d4e39f04e53..10bd2ffec3f 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -2349,9 +2349,8 @@ the same names as used in the original source code, when possible."
2349 ;; If definition is a macro, find the function inside it. 2349 ;; If definition is a macro, find the function inside it.
2350 (if (eq (car-safe def) 'macro) (setq def (cdr def))) 2350 (if (eq (car-safe def) 'macro) (setq def (cdr def)))
2351 (cond 2351 (cond
2352 ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0)) 2352 ((and (closurep def) (listp (aref def 0))) (aref def 0))
2353 ((eq (car-safe def) 'lambda) (nth 1 def)) 2353 ((eq (car-safe def) 'lambda) (nth 1 def))
2354 ((eq (car-safe def) 'closure) (nth 2 def))
2355 ((and (featurep 'native-compile) 2354 ((and (featurep 'native-compile)
2356 (subrp def) 2355 (subrp def)
2357 (listp (subr-native-lambda-list def))) 2356 (listp (subr-native-lambda-list def)))
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 4e02cd1d890..eb72f128c07 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -275,10 +275,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
275 275
276 276
277(define-hash-table-test 'profiler-function-equal #'function-equal 277(define-hash-table-test 'profiler-function-equal #'function-equal
278 (lambda (f) (cond 278 (lambda (f) (if (closurep f) (aref f 1) f)))
279 ((byte-code-function-p f) (aref f 1))
280 ((eq (car-safe f) 'closure) (cddr f))
281 (t f))))
282 279
283(defun profiler-calltree-build-unified (tree log) 280(defun profiler-calltree-build-unified (tree log)
284 ;; Let's try to unify all those partial backtraces into a single 281 ;; Let's try to unify all those partial backtraces into a single
diff --git a/lisp/simple.el b/lisp/simple.el
index e4629ce3db7..be64f3574e0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2703,15 +2703,14 @@ function as needed."
2703 (or (stringp doc) 2703 (or (stringp doc)
2704 (fixnump doc) (fixnump (cdr-safe doc)))))) 2704 (fixnump doc) (fixnump (cdr-safe doc))))))
2705 (pcase function 2705 (pcase function
2706 ((pred byte-code-function-p) 2706 ((pred closurep)
2707 (when (> (length function) 4) 2707 (when (> (length function) 4)
2708 (let ((doc (aref function 4))) 2708 (let ((doc (aref function 4)))
2709 (when (funcall docstring-p doc) doc)))) 2709 (when (funcall docstring-p doc) doc))))
2710 ((or (pred stringp) (pred vectorp)) "Keyboard macro.") 2710 ((or (pred stringp) (pred vectorp)) "Keyboard macro.")
2711 (`(keymap . ,_) 2711 (`(keymap . ,_)
2712 "Prefix command (definition is a keymap associating keystrokes with commands).") 2712 "Prefix command (definition is a keymap associating keystrokes with commands).")
2713 ((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body) 2713 ((or `(lambda ,_args . ,body) `(autoload ,_file . ,body))
2714 `(autoload ,_file . ,body))
2715 (let ((doc (car body))) 2714 (let ((doc (car body)))
2716 (when (funcall docstring-p doc) 2715 (when (funcall docstring-p doc)
2717 doc))) 2716 doc)))
diff --git a/src/callint.c b/src/callint.c
index b31faba8704..9d6f2ab2888 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -319,10 +319,10 @@ invoke it (via an `interactive' spec that contains, for instance, an
319 { 319 {
320 Lisp_Object funval = Findirect_function (function, Qt); 320 Lisp_Object funval = Findirect_function (function, Qt);
321 uintmax_t events = num_input_events; 321 uintmax_t events = num_input_events;
322 Lisp_Object env = CLOSUREP (funval) && CONSP (AREF (funval, CLOSURE_CODE))
323 ? AREF (funval, CLOSURE_CONSTANTS) : Qnil;
322 /* Compute the arg values using the user's expression. */ 324 /* Compute the arg values using the user's expression. */
323 specs = Feval (specs, 325 specs = Feval (specs, env);
324 CONSP (funval) && EQ (Qclosure, XCAR (funval))
325 ? CAR_SAFE (XCDR (funval)) : Qnil);
326 if (events != num_input_events || !NILP (record_flag)) 326 if (events != num_input_events || !NILP (record_flag))
327 { 327 {
328 /* We should record this command on the command history. 328 /* We should record this command on the command history.
diff --git a/src/data.c b/src/data.c
index 681054ff8cb..ea611ad1abf 100644
--- a/src/data.c
+++ b/src/data.c
@@ -248,7 +248,9 @@ a fixed set of types. */)
248 return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form 248 return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form
249 : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp 249 : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp
250 : Qprimitive_function; 250 : Qprimitive_function;
251 case PVEC_CLOSURE: return Qcompiled_function; 251 case PVEC_CLOSURE:
252 return CONSP (AREF (object, CLOSURE_CODE))
253 ? Qinterpreted_function : Qbyte_code_function;
252 case PVEC_BUFFER: return Qbuffer; 254 case PVEC_BUFFER: return Qbuffer;
253 case PVEC_CHAR_TABLE: return Qchar_table; 255 case PVEC_CHAR_TABLE: return Qchar_table;
254 case PVEC_BOOL_VECTOR: return Qbool_vector; 256 case PVEC_BOOL_VECTOR: return Qbool_vector;
@@ -518,12 +520,32 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
518 return Qnil; 520 return Qnil;
519} 521}
520 522
523DEFUN ("closurep", Fclosurep, Sclosurep,
524 1, 1, 0,
525 doc: /* Return t if OBJECT is a function of type `closure'. */)
526 (Lisp_Object object)
527{
528 if (CLOSUREP (object))
529 return Qt;
530 return Qnil;
531}
532
521DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, 533DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
522 1, 1, 0, 534 1, 1, 0,
523 doc: /* Return t if OBJECT is a byte-compiled function object. */) 535 doc: /* Return t if OBJECT is a byte-compiled function object. */)
524 (Lisp_Object object) 536 (Lisp_Object object)
525{ 537{
526 if (CLOSUREP (object)) 538 if (CLOSUREP (object) && STRINGP (AREF (object, CLOSURE_CODE)))
539 return Qt;
540 return Qnil;
541}
542
543DEFUN ("interpreted-function-p", Finterpreted_function_p,
544 Sinterpreted_function_p, 1, 1, 0,
545 doc: /* Return t if OBJECT is a function of type `interpreted-function'. */)
546 (Lisp_Object object)
547{
548 if (CLOSUREP (object) && CONSP (AREF (object, CLOSURE_CODE)))
527 return Qt; 549 return Qt;
528 return Qnil; 550 return Qnil;
529} 551}
@@ -1174,17 +1196,11 @@ Value, if non-nil, is a list (interactive SPEC). */)
1174 else if (CONSP (fun)) 1196 else if (CONSP (fun))
1175 { 1197 {
1176 Lisp_Object funcar = XCAR (fun); 1198 Lisp_Object funcar = XCAR (fun);
1177 if (EQ (funcar, Qclosure) 1199 if (EQ (funcar, Qlambda))
1178 || EQ (funcar, Qlambda))
1179 { 1200 {
1180 Lisp_Object form = Fcdr (XCDR (fun)); 1201 Lisp_Object form = Fcdr (XCDR (fun));
1181 if (EQ (funcar, Qclosure))
1182 form = Fcdr (form);
1183 Lisp_Object spec = Fassq (Qinteractive, form); 1202 Lisp_Object spec = Fassq (Qinteractive, form);
1184 if (NILP (spec) && VALID_DOCSTRING_P (CAR_SAFE (form))) 1203 if (NILP (Fcdr (Fcdr (spec))))
1185 /* A "docstring" is a sign that we may have an OClosure. */
1186 genfun = true;
1187 else if (NILP (Fcdr (Fcdr (spec))))
1188 return spec; 1204 return spec;
1189 else 1205 else
1190 return list2 (Qinteractive, Fcar (Fcdr (spec))); 1206 return list2 (Qinteractive, Fcar (Fcdr (spec)));
@@ -1257,12 +1273,9 @@ The value, if non-nil, is a list of mode name symbols. */)
1257 else if (CONSP (fun)) 1273 else if (CONSP (fun))
1258 { 1274 {
1259 Lisp_Object funcar = XCAR (fun); 1275 Lisp_Object funcar = XCAR (fun);
1260 if (EQ (funcar, Qclosure) 1276 if (EQ (funcar, Qlambda))
1261 || EQ (funcar, Qlambda))
1262 { 1277 {
1263 Lisp_Object form = Fcdr (XCDR (fun)); 1278 Lisp_Object form = Fcdr (XCDR (fun));
1264 if (EQ (funcar, Qclosure))
1265 form = Fcdr (form);
1266 return Fcdr (Fcdr (Fassq (Qinteractive, form))); 1279 return Fcdr (Fcdr (Fassq (Qinteractive, form)));
1267 } 1280 }
1268 } 1281 }
@@ -4224,7 +4237,8 @@ syms_of_data (void)
4224 DEFSYM (Qspecial_form, "special-form"); 4237 DEFSYM (Qspecial_form, "special-form");
4225 DEFSYM (Qprimitive_function, "primitive-function"); 4238 DEFSYM (Qprimitive_function, "primitive-function");
4226 DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); 4239 DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
4227 DEFSYM (Qcompiled_function, "compiled-function"); 4240 DEFSYM (Qbyte_code_function, "byte-code-function");
4241 DEFSYM (Qinterpreted_function, "interpreted-function");
4228 DEFSYM (Qbuffer, "buffer"); 4242 DEFSYM (Qbuffer, "buffer");
4229 DEFSYM (Qframe, "frame"); 4243 DEFSYM (Qframe, "frame");
4230 DEFSYM (Qvector, "vector"); 4244 DEFSYM (Qvector, "vector");
@@ -4289,6 +4303,8 @@ syms_of_data (void)
4289 defsubr (&Smarkerp); 4303 defsubr (&Smarkerp);
4290 defsubr (&Ssubrp); 4304 defsubr (&Ssubrp);
4291 defsubr (&Sbyte_code_function_p); 4305 defsubr (&Sbyte_code_function_p);
4306 defsubr (&Sinterpreted_function_p);
4307 defsubr (&Sclosurep);
4292 defsubr (&Smodule_function_p); 4308 defsubr (&Smodule_function_p);
4293 defsubr (&Schar_or_string_p); 4309 defsubr (&Schar_or_string_p);
4294 defsubr (&Sthreadp); 4310 defsubr (&Sthreadp);
diff --git a/src/eval.c b/src/eval.c
index a7d860114cf..fd388706108 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -510,6 +510,33 @@ usage: (quote ARG) */)
510 return XCAR (args); 510 return XCAR (args);
511} 511}
512 512
513DEFUN ("make-interpreted-closure", Fmake_interpreted_closure,
514 Smake_interpreted_closure, 3, 5, 0,
515 doc: /* Make an interpreted closure.
516ARGS should be the list of formal arguments.
517BODY should be a non-empty list of forms.
518ENV should be a lexical environment, like the second argument of `eval'.
519IFORM if non-nil should be of the form (interactive ...). */)
520 (Lisp_Object args, Lisp_Object body, Lisp_Object env,
521 Lisp_Object docstring, Lisp_Object iform)
522{
523 CHECK_CONS (body); /* Make sure it's not confused with byte-code! */
524 CHECK_LIST (args);
525 CHECK_LIST (iform);
526 Lisp_Object ifcdr = Fcdr (iform);
527 Lisp_Object slots[] = { args, body, env, Qnil, docstring,
528 NILP (Fcdr (ifcdr))
529 ? Fcar (ifcdr)
530 : CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr)) };
531 /* Adjusting the size is indispensable since, as for byte-code objects,
532 we distinguish interactive functions by the presence or absence of the
533 iform slot. */
534 Lisp_Object val
535 = Fvector (!NILP (iform) ? 6 : !NILP (docstring) ? 5 : 3, slots);
536 XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE);
537 return val;
538}
539
513DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, 540DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
514 doc: /* Like `quote', but preferred for objects which are functions. 541 doc: /* Like `quote', but preferred for objects which are functions.
515In byte compilation, `function' causes its argument to be handled by 542In byte compilation, `function' causes its argument to be handled by
@@ -525,33 +552,55 @@ usage: (function ARG) */)
525 if (!NILP (XCDR (args))) 552 if (!NILP (XCDR (args)))
526 xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); 553 xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
527 554
528 if (!NILP (Vinternal_interpreter_environment) 555 if (CONSP (quoted)
529 && CONSP (quoted)
530 && EQ (XCAR (quoted), Qlambda)) 556 && EQ (XCAR (quoted), Qlambda))
531 { /* This is a lambda expression within a lexical environment; 557 { /* This is a lambda expression within a lexical environment;
532 return an interpreted closure instead of a simple lambda. */ 558 return an interpreted closure instead of a simple lambda. */
533 Lisp_Object cdr = XCDR (quoted); 559 Lisp_Object cdr = XCDR (quoted);
534 Lisp_Object tmp = cdr; 560 Lisp_Object args = Fcar (cdr);
535 if (CONSP (tmp) 561 cdr = Fcdr (cdr);
536 && (tmp = XCDR (tmp), CONSP (tmp)) 562 Lisp_Object docstring = Qnil, iform = Qnil;
537 && (tmp = XCAR (tmp), CONSP (tmp)) 563 if (CONSP (cdr))
538 && (EQ (QCdocumentation, XCAR (tmp)))) 564 {
539 { /* Handle the special (:documentation <form>) to build the docstring 565 docstring = XCAR (cdr);
566 if (STRINGP (docstring))
567 {
568 Lisp_Object tmp = XCDR (cdr);
569 if (!NILP (tmp))
570 cdr = tmp;
571 else /* It's not a docstring, it's a return value. */
572 docstring = Qnil;
573 }
574 /* Handle the special (:documentation <form>) to build the docstring
540 dynamically. */ 575 dynamically. */
541 Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp))); 576 else if (CONSP (docstring)
542 if (SYMBOLP (docstring) && !NILP (docstring)) 577 && EQ (QCdocumentation, XCAR (docstring))
543 /* Hack for OClosures: Allow the docstring to be a symbol 578 && (docstring = eval_sub (Fcar (XCDR (docstring))),
544 * (the OClosure's type). */ 579 true))
545 docstring = Fsymbol_name (docstring); 580 cdr = XCDR (cdr);
546 CHECK_STRING (docstring); 581 else
547 cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr)))); 582 docstring = Qnil; /* Not a docstring after all. */
548 } 583 }
549 if (NILP (Vinternal_make_interpreted_closure_function)) 584 if (CONSP (cdr))
550 return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, cdr)); 585 {
586 iform = XCAR (cdr);
587 if (CONSP (iform)
588 && EQ (Qinteractive, XCAR (iform)))
589 cdr = XCDR (cdr);
590 else
591 iform = Qnil; /* Not an interactive-form after all. */
592 }
593 if (NILP (cdr))
594 cdr = Fcons (Qnil, Qnil); /* Make sure the body is never empty! */
595
596 if (NILP (Vinternal_interpreter_environment)
597 || NILP (Vinternal_make_interpreted_closure_function))
598 return Fmake_interpreted_closure
599 (args, cdr, Vinternal_interpreter_environment, docstring, iform);
551 else 600 else
552 return call2 (Vinternal_make_interpreted_closure_function, 601 return call5 (Vinternal_make_interpreted_closure_function,
553 Fcons (Qlambda, cdr), 602 args, cdr, Vinternal_interpreter_environment,
554 Vinternal_interpreter_environment); 603 docstring, iform);
555 } 604 }
556 else 605 else
557 /* Simply quote the argument. */ 606 /* Simply quote the argument. */
@@ -2193,15 +2242,12 @@ then strings and vectors are not accepted. */)
2193 else 2242 else
2194 { 2243 {
2195 Lisp_Object body = CDR_SAFE (XCDR (fun)); 2244 Lisp_Object body = CDR_SAFE (XCDR (fun));
2196 if (EQ (funcar, Qclosure)) 2245 if (!EQ (funcar, Qlambda))
2197 body = CDR_SAFE (body);
2198 else if (!EQ (funcar, Qlambda))
2199 return Qnil; 2246 return Qnil;
2200 if (!NILP (Fassq (Qinteractive, body))) 2247 if (!NILP (Fassq (Qinteractive, body)))
2201 return Qt; 2248 return Qt;
2202 else if (VALID_DOCSTRING_P (CAR_SAFE (body))) 2249 else
2203 /* A "docstring" is a sign that we may have an OClosure. */ 2250 return Qnil;
2204 genfun = true;
2205 } 2251 }
2206 } 2252 }
2207 2253
@@ -2611,8 +2657,7 @@ eval_sub (Lisp_Object form)
2611 exp = unbind_to (count1, exp); 2657 exp = unbind_to (count1, exp);
2612 val = eval_sub (exp); 2658 val = eval_sub (exp);
2613 } 2659 }
2614 else if (EQ (funcar, Qlambda) 2660 else if (EQ (funcar, Qlambda))
2615 || EQ (funcar, Qclosure))
2616 return apply_lambda (fun, original_args, count); 2661 return apply_lambda (fun, original_args, count);
2617 else 2662 else
2618 xsignal1 (Qinvalid_function, original_fun); 2663 xsignal1 (Qinvalid_function, original_fun);
@@ -2950,7 +2995,7 @@ FUNCTIONP (Lisp_Object object)
2950 else if (CONSP (object)) 2995 else if (CONSP (object))
2951 { 2996 {
2952 Lisp_Object car = XCAR (object); 2997 Lisp_Object car = XCAR (object);
2953 return EQ (car, Qlambda) || EQ (car, Qclosure); 2998 return EQ (car, Qlambda);
2954 } 2999 }
2955 else 3000 else
2956 return false; 3001 return false;
@@ -2980,8 +3025,7 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args)
2980 Lisp_Object funcar = XCAR (fun); 3025 Lisp_Object funcar = XCAR (fun);
2981 if (!SYMBOLP (funcar)) 3026 if (!SYMBOLP (funcar))
2982 xsignal1 (Qinvalid_function, original_fun); 3027 xsignal1 (Qinvalid_function, original_fun);
2983 if (EQ (funcar, Qlambda) 3028 if (EQ (funcar, Qlambda))
2984 || EQ (funcar, Qclosure))
2985 return funcall_lambda (fun, numargs, args); 3029 return funcall_lambda (fun, numargs, args);
2986 else if (EQ (funcar, Qautoload)) 3030 else if (EQ (funcar, Qautoload))
2987 { 3031 {
@@ -3165,16 +3209,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
3165 3209
3166 if (CONSP (fun)) 3210 if (CONSP (fun))
3167 { 3211 {
3168 if (EQ (XCAR (fun), Qclosure)) 3212 lexenv = Qnil;
3169 {
3170 Lisp_Object cdr = XCDR (fun); /* Drop `closure'. */
3171 if (! CONSP (cdr))
3172 xsignal1 (Qinvalid_function, fun);
3173 fun = cdr;
3174 lexenv = XCAR (fun);
3175 }
3176 else
3177 lexenv = Qnil;
3178 syms_left = XCDR (fun); 3213 syms_left = XCDR (fun);
3179 if (CONSP (syms_left)) 3214 if (CONSP (syms_left))
3180 syms_left = XCAR (syms_left); 3215 syms_left = XCAR (syms_left);
@@ -3189,10 +3224,12 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
3189 engine directly. */ 3224 engine directly. */
3190 if (FIXNUMP (syms_left)) 3225 if (FIXNUMP (syms_left))
3191 return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector); 3226 return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector);
3192 /* Otherwise the bytecode object uses dynamic binding and the 3227 /* Otherwise the closure either is interpreted
3193 ARGLIST slot contains a standard formal argument list whose 3228 or uses dynamic binding and the ARGLIST slot contains a standard
3194 variables are bound dynamically below. */ 3229 formal argument list whose variables are bound dynamically below. */
3195 lexenv = Qnil; 3230 lexenv = CONSP (AREF (fun, CLOSURE_CODE))
3231 ? AREF (fun, CLOSURE_CONSTANTS)
3232 : Qnil;
3196 } 3233 }
3197#ifdef HAVE_MODULES 3234#ifdef HAVE_MODULES
3198 else if (MODULE_FUNCTIONP (fun)) 3235 else if (MODULE_FUNCTIONP (fun))
@@ -3280,7 +3317,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
3280 val = XSUBR (fun)->function.a0 (); 3317 val = XSUBR (fun)->function.a0 ();
3281 } 3318 }
3282 else 3319 else
3283 val = exec_byte_code (fun, 0, 0, NULL); 3320 {
3321 eassert (CLOSUREP (fun));
3322 val = CONSP (AREF (fun, CLOSURE_CODE))
3323 /* Interpreted function. */
3324 ? Fprogn (AREF (fun, CLOSURE_CODE))
3325 /* Dynbound bytecode. */
3326 : exec_byte_code (fun, 0, 0, NULL);
3327 }
3284 3328
3285 return unbind_to (count, val); 3329 return unbind_to (count, val);
3286} 3330}
@@ -3330,8 +3374,7 @@ function with `&rest' args, or `unevalled' for a special form. */)
3330 funcar = XCAR (function); 3374 funcar = XCAR (function);
3331 if (!SYMBOLP (funcar)) 3375 if (!SYMBOLP (funcar))
3332 xsignal1 (Qinvalid_function, original); 3376 xsignal1 (Qinvalid_function, original);
3333 if (EQ (funcar, Qlambda) 3377 if (EQ (funcar, Qlambda))
3334 || EQ (funcar, Qclosure))
3335 result = lambda_arity (function); 3378 result = lambda_arity (function);
3336 else if (EQ (funcar, Qautoload)) 3379 else if (EQ (funcar, Qautoload))
3337 { 3380 {
@@ -3352,11 +3395,6 @@ lambda_arity (Lisp_Object fun)
3352 3395
3353 if (CONSP (fun)) 3396 if (CONSP (fun))
3354 { 3397 {
3355 if (EQ (XCAR (fun), Qclosure))
3356 {
3357 fun = XCDR (fun); /* Drop `closure'. */
3358 CHECK_CONS (fun);
3359 }
3360 syms_left = XCDR (fun); 3398 syms_left = XCDR (fun);
3361 if (CONSP (syms_left)) 3399 if (CONSP (syms_left))
3362 syms_left = XCAR (syms_left); 3400 syms_left = XCAR (syms_left);
@@ -4265,7 +4303,6 @@ before making `inhibit-quit' nil. */);
4265 DEFSYM (Qcommandp, "commandp"); 4303 DEFSYM (Qcommandp, "commandp");
4266 DEFSYM (Qand_rest, "&rest"); 4304 DEFSYM (Qand_rest, "&rest");
4267 DEFSYM (Qand_optional, "&optional"); 4305 DEFSYM (Qand_optional, "&optional");
4268 DEFSYM (Qclosure, "closure");
4269 DEFSYM (QCdocumentation, ":documentation"); 4306 DEFSYM (QCdocumentation, ":documentation");
4270 DEFSYM (Qdebug, "debug"); 4307 DEFSYM (Qdebug, "debug");
4271 DEFSYM (Qdebug_early, "debug-early"); 4308 DEFSYM (Qdebug_early, "debug-early");
@@ -4423,6 +4460,7 @@ alist of active lexical bindings. */);
4423 defsubr (&Ssetq); 4460 defsubr (&Ssetq);
4424 defsubr (&Squote); 4461 defsubr (&Squote);
4425 defsubr (&Sfunction); 4462 defsubr (&Sfunction);
4463 defsubr (&Smake_interpreted_closure);
4426 defsubr (&Sdefault_toplevel_value); 4464 defsubr (&Sdefault_toplevel_value);
4427 defsubr (&Sset_default_toplevel_value); 4465 defsubr (&Sset_default_toplevel_value);
4428 defsubr (&Sdefvar); 4466 defsubr (&Sdefvar);
diff --git a/src/lread.c b/src/lread.c
index 8b614e6220e..983fdb883ff 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3523,25 +3523,32 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
3523 } 3523 }
3524 } 3524 }
3525 3525
3526 if (!(size >= CLOSURE_STACK_DEPTH + 1 && size <= CLOSURE_INTERACTIVE + 1 3526 if (!(size >= CLOSURE_STACK_DEPTH && size <= CLOSURE_INTERACTIVE + 1
3527 && (FIXNUMP (vec[CLOSURE_ARGLIST]) 3527 && (FIXNUMP (vec[CLOSURE_ARGLIST])
3528 || CONSP (vec[CLOSURE_ARGLIST]) 3528 || CONSP (vec[CLOSURE_ARGLIST])
3529 || NILP (vec[CLOSURE_ARGLIST])) 3529 || NILP (vec[CLOSURE_ARGLIST]))
3530 && STRINGP (vec[CLOSURE_CODE]) 3530 && ((STRINGP (vec[CLOSURE_CODE]) /* Byte-code function. */
3531 && VECTORP (vec[CLOSURE_CONSTANTS]) 3531 && VECTORP (vec[CLOSURE_CONSTANTS])
3532 && FIXNATP (vec[CLOSURE_STACK_DEPTH]))) 3532 && size > CLOSURE_STACK_DEPTH
3533 && (FIXNATP (vec[CLOSURE_STACK_DEPTH])))
3534 || (CONSP (vec[CLOSURE_CODE]) /* Interpreted function. */
3535 && (CONSP (vec[CLOSURE_CONSTANTS])
3536 || NILP (vec[CLOSURE_CONSTANTS]))))))
3533 invalid_syntax ("Invalid byte-code object", readcharfun); 3537 invalid_syntax ("Invalid byte-code object", readcharfun);
3534 3538
3535 if (STRING_MULTIBYTE (vec[CLOSURE_CODE])) 3539 if (STRINGP (vec[CLOSURE_CODE]))
3536 /* BYTESTR must have been produced by Emacs 20.2 or earlier 3540 {
3537 because it produced a raw 8-bit string for byte-code and 3541 if (STRING_MULTIBYTE (vec[CLOSURE_CODE]))
3538 now such a byte-code string is loaded as multibyte with 3542 /* BYTESTR must have been produced by Emacs 20.2 or earlier
3539 raw 8-bit characters converted to multibyte form. 3543 because it produced a raw 8-bit string for byte-code and
3540 Convert them back to the original unibyte form. */ 3544 now such a byte-code string is loaded as multibyte with
3541 vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]); 3545 raw 8-bit characters converted to multibyte form.
3542 3546 Convert them back to the original unibyte form. */
3543 /* Bytecode must be immovable. */ 3547 vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]);
3544 pin_string (vec[CLOSURE_CODE]); 3548
3549 /* Bytecode must be immovable. */
3550 pin_string (vec[CLOSURE_CODE]);
3551 }
3545 3552
3546 XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE); 3553 XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE);
3547 return obj; 3554 return obj;
diff --git a/src/profiler.c b/src/profiler.c
index ac23a97b672..6e1dc46abd3 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -170,9 +170,7 @@ trace_hash (Lisp_Object *trace, int depth)
170 { 170 {
171 Lisp_Object f = trace[i]; 171 Lisp_Object f = trace[i];
172 EMACS_UINT hash1 172 EMACS_UINT hash1
173 = (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE)) 173 = (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE)) : XHASH (f));
174 : (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f)))
175 ? XHASH (XCDR (XCDR (f))) : XHASH (f));
176 hash = sxhash_combine (hash, hash1); 174 hash = sxhash_combine (hash, hash1);
177 } 175 }
178 return hash; 176 return hash;
@@ -677,10 +675,6 @@ the same lambda expression, or are really unrelated function. */)
677 res = true; 675 res = true;
678 else if (CLOSUREP (f1) && CLOSUREP (f2)) 676 else if (CLOSUREP (f1) && CLOSUREP (f2))
679 res = EQ (AREF (f1, CLOSURE_CODE), AREF (f2, CLOSURE_CODE)); 677 res = EQ (AREF (f1, CLOSURE_CODE), AREF (f2, CLOSURE_CODE));
680 else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2))
681 && EQ (Qclosure, XCAR (f1))
682 && EQ (Qclosure, XCAR (f2)))
683 res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2)));
684 else 678 else
685 res = false; 679 res = false;
686 return res ? Qt : Qnil; 680 return res ? Qt : Qnil;
diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el
index 5358bcaeb5c..c59a6b9f8f1 100644
--- a/test/lisp/emacs-lisp/macroexp-resources/vk.el
+++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el
@@ -78,29 +78,31 @@
78 78
79(defconst vk-val3 (eval-when-compile (vk-f3 0))) 79(defconst vk-val3 (eval-when-compile (vk-f3 0)))
80 80
81(defconst vk-f4 '(lambda (x) 81(defconst vk-f4 (eval '(lambda (x)
82 (defvar vk-v4) 82 (defvar vk-v4)
83 (let ((vk-v4 31) 83 (let ((vk-v4 31)
84 (y 32)) 84 (y 32))
85 (ignore vk-v4 x y) 85 (ignore vk-v4 x y)
86 (list 86 (list
87 (vk-variable-kind vk-a) ; dyn 87 (vk-variable-kind vk-a) ; dyn
88 (vk-variable-kind vk-b) ; dyn 88 (vk-variable-kind vk-b) ; dyn
89 (vk-variable-kind vk-v4) ; dyn 89 (vk-variable-kind vk-v4) ; dyn
90 (vk-variable-kind x) ; dyn 90 (vk-variable-kind x) ; dyn
91 (vk-variable-kind y))))) ; dyn 91 (vk-variable-kind y)))) ; dyn
92 92 nil))
93(defconst vk-f5 '(closure (t) (x) 93
94 (defvar vk-v5) 94(defconst vk-f5 (eval '(lambda (x)
95 (let ((vk-v5 41) 95 (defvar vk-v5)
96 (y 42)) 96 (let ((vk-v5 41)
97 (ignore vk-v5 x y) 97 (y 42))
98 (list 98 (ignore vk-v5 x y)
99 (vk-variable-kind vk-a) ; dyn 99 (list
100 (vk-variable-kind vk-b) ; dyn 100 (vk-variable-kind vk-a) ; dyn
101 (vk-variable-kind vk-v5) ; dyn 101 (vk-variable-kind vk-b) ; dyn
102 (vk-variable-kind x) ; lex 102 (vk-variable-kind vk-v5) ; dyn
103 (vk-variable-kind y))))) ; lex 103 (vk-variable-kind x) ; lex
104 (vk-variable-kind y)))) ; lex
105 t))
104 106
105(defun vk-f6 () 107(defun vk-f6 ()
106 (eval '(progn 108 (eval '(progn
diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el
index 78f87399afb..dda1b1ced84 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-tests.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el
@@ -367,8 +367,9 @@
367 (should (equal (funcall it) "foo3foo"))) 367 (should (equal (funcall it) "foo3foo")))
368 368
369 (ert-info ("Exits clean") 369 (ert-info ("Exits clean")
370 (when (listp (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled 370 (when (interpreted-function-p
371 (should (eq 'closure (car (alist-get 'f (erc-d-dialog-vars dialog)))))) 371 (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled
372 (should (aref (alist-get 'f (erc-d-dialog-vars dialog)) 2)))
372 (should-not (funcall it)) 373 (should-not (funcall it))
373 (should (equal (erc-d-dialog-vars dialog) 374 (should (equal (erc-d-dialog-vars dialog)
374 `((:a . 1) 375 `((:a . 1)
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 1beeb77640c..82350a4bc71 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -63,14 +63,14 @@ Return first line of the output of (describe-function-1 FUNC)."
63 (should (string-match regexp result)))) 63 (should (string-match regexp result))))
64 64
65(ert-deftest help-fns-test-lisp-defun () 65(ert-deftest help-fns-test-lisp-defun ()
66 (let ((regexp (if (featurep 'native-compile) 66 (let ((regexp "a \\([^ ]+\\) in .+subr\\.el")
67 "a subr-native-elisp in .+subr\\.el"
68 "a compiled-function in .+subr\\.el"))
69 (result (help-fns-tests--describe-function 'last))) 67 (result (help-fns-tests--describe-function 'last)))
70 (should (string-match regexp result)))) 68 (should (string-match regexp result))
69 (should (member (match-string 1 result)
70 '("subr-native-elisp" "byte-code-function")))))
71 71
72(ert-deftest help-fns-test-lisp-defsubst () 72(ert-deftest help-fns-test-lisp-defsubst ()
73 (let ((regexp "a compiled-function in .+subr\\.el") 73 (let ((regexp "a byte-code-function in .+subr\\.el")
74 (result (help-fns-tests--describe-function 'posn-window))) 74 (result (help-fns-tests--describe-function 'posn-window)))
75 (should (string-match regexp result)))) 75 (should (string-match regexp result))))
76 76