diff options
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 | |||
| 120 | definition of @var{symbol} must be the actual code for the function; | 120 | definition 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 |
| 122 | value is the byte-code function object which is the compiled | 122 | value is the byte-code function object which is the compiled |
| 123 | definition of @var{symbol} (@pxref{Byte-Code Objects}). | 123 | definition of @var{symbol} (@pxref{Closure Objects}). |
| 124 | 124 | ||
| 125 | @example | 125 | @example |
| 126 | @group | 126 | @group |
| @@ -487,21 +487,22 @@ string for details. | |||
| 487 | using @code{error}. If so, set @code{byte-compile-error-on-warn} to a | 487 | using @code{error}. If so, set @code{byte-compile-error-on-warn} to a |
| 488 | non-@code{nil} value. | 488 | non-@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 | 497 | Closures are used both for byte-compiled Lisp functions as well as for |
| 498 | a function to be called, Emacs uses the byte-code interpreter to | 498 | interpreted Lisp functions. Whenever such an object appears as |
| 499 | execute the byte-code. | 499 | a function to be called, Emacs uses the appropriate interpreter to |
| 500 | execute 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 |
| 502 | elements can be accessed using @code{aref}. Its printed | 503 | elements can be accessed using @code{aref}. Its printed |
| 503 | representation is like that for a vector, with an additional @samp{#} | 504 | representation is like that for a vector, with an additional @samp{#} |
| 504 | before the opening @samp{[}. It must have at least four elements; | 505 | before the opening @samp{[}. It must have at least three elements; |
| 505 | there is no maximum number, but only the first six elements have any | 506 | there is no maximum number, but only the first six elements have any |
| 506 | normal use. They are: | 507 | normal use. They are: |
| 507 | 508 | ||
| @@ -515,20 +516,28 @@ zero to 6, and the maximum number of arguments in bits 8 to 14. If | |||
| 515 | the argument list uses @code{&rest}, then bit 7 is set; otherwise it's | 516 | the argument list uses @code{&rest}, then bit 7 is set; otherwise it's |
| 516 | cleared. | 517 | cleared. |
| 517 | 518 | ||
| 518 | If @var{argdesc} is a list, the arguments will be dynamically bound | 519 | When the closure is a byte-code function, |
| 520 | if @var{argdesc} is a list, the arguments will be dynamically bound | ||
| 519 | before executing the byte code. If @var{argdesc} is an integer, the | 521 | before executing the byte code. If @var{argdesc} is an integer, the |
| 520 | arguments will be instead pushed onto the stack of the byte-code | 522 | arguments will be instead pushed onto the stack of the byte-code |
| 521 | interpreter, before executing the code. | 523 | interpreter, before executing the code. |
| 522 | 524 | ||
| 523 | @item byte-code | 525 | @item code |
| 524 | The string containing the byte-code instructions. | 526 | For interpreted functions, this element is the (non-empty) list of Lisp |
| 527 | forms that make up the function's body. For byte-compiled functions, it | ||
| 528 | is the string containing the byte-code instructions. | ||
| 525 | 529 | ||
| 526 | @item constants | 530 | @item constants |
| 527 | The vector of Lisp objects referenced by the byte code. These include | 531 | For byte-compiled functions, this holds the vector of Lisp objects |
| 528 | symbols used as function names and variable names. | 532 | referenced by the byte code. These include symbols used as function |
| 533 | names and variable names. | ||
| 534 | For interpreted functions, this is @code{nil} if the function is using the old | ||
| 535 | dynamically scoped dialect of Emacs Lisp, and otherwise it holds the | ||
| 536 | function's lexical environment. | ||
| 529 | 537 | ||
| 530 | @item stacksize | 538 | @item stacksize |
| 531 | The maximum stack size this function needs. | 539 | The maximum stack size this function needs. This element is left unused |
| 540 | for interpreted functions. | ||
| 532 | 541 | ||
| 533 | @item docstring | 542 | @item docstring |
| 534 | The documentation string (if any); otherwise, @code{nil}. The value may | 543 | The 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 |
| 561 | This function constructs and returns a byte-code function object | 570 | This function constructs and returns a closure which represents the |
| 562 | with @var{elements} as its elements. | 571 | byte-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 | |||
| 567 | when you call the function. Always leave it to the byte compiler to | 576 | when you call the function. Always leave it to the byte compiler to |
| 568 | create these objects; it makes the elements consistent (we hope). | 577 | create these objects; it makes the elements consistent (we hope). |
| 569 | 578 | ||
| 579 | The 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 | ||
| 583 | This function constructs and returns a closure representing the | ||
| 584 | interpreted 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 | ||
| 586 | lexical environment in the same form as used with @code{eval} | ||
| 587 | (@pxref{Eval}). The documentation @var{docstring} if non-@code{nil} should be | ||
| 588 | a string, and the interactive form @var{iform} if non-@code{nil} should be of | ||
| 589 | the form @w{@code{(interactive @var{arg-descriptor})}} (@pxref{Using | ||
| 590 | Interactive}). | ||
| 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 | |||
| 595 | point is left before the output. | 618 | point is left before the output. |
| 596 | 619 | ||
| 597 | The argument @var{object} can be a function name, a lambda expression | 620 | The 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 |
| 599 | Objects}). If it is a lambda expression, @code{disassemble} compiles | 622 | Objects}). If it is a lambda expression, @code{disassemble} compiles |
| 600 | it and disassembles the resulting compiled code. | 623 | it 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 |
| 2412 | Debugger entered--Lisp error: (error "Oops") | 2412 | Debugger 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 | ||
| 663 | Native Compilation | 663 | Native 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 |
| 132 | A function that has been compiled by the byte compiler. | 132 | A 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 | |||
| 227 | a function loaded from a dynamic module (@pxref{Dynamic Modules}). | 227 | a function loaded from a dynamic module (@pxref{Dynamic Modules}). |
| 228 | @end defun | 228 | @end defun |
| 229 | 229 | ||
| 230 | @defun interpreted-function-p object | ||
| 231 | This function returns @code{t} if @var{object} is an interpreted function. | ||
| 232 | @end defun | ||
| 233 | |||
| 234 | @defun closurep object | ||
| 235 | This function returns @code{t} if @var{object} is a closure, which is | ||
| 236 | a particular kind of function object. Currently closures are used | ||
| 237 | for all byte-code functions and all interpreted functions. | ||
| 238 | @end defun | ||
| 239 | |||
| 230 | @defun subr-arity subr | 240 | @defun subr-arity subr |
| 231 | This works like @code{func-arity}, but only for built-in functions and | 241 | This works like @code{func-arity}, but only for built-in functions and |
| 232 | without symbol indirection. It signals an error for non-built-in | 242 | without symbol indirection. It signals an error for non-built-in |
| @@ -1136,8 +1146,7 @@ Functions}). @xref{describe-symbols example}, for a realistic example | |||
| 1136 | of this. | 1146 | of 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 |
| 1139 | function, you can in principle use any method to construct the list. | 1149 | function, you should use the @code{lambda} macro, or the |
| 1140 | But 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 | ||
| 1148 | Under dynamic binding, this macro effectively makes @code{lambda} | 1157 | For example, this macro makes @code{lambda} forms almost self-quoting: |
| 1149 | forms self-quoting: evaluating a form whose @sc{car} is @code{lambda} | 1158 | evaluating a form whose @sc{car} is @code{lambda} yields a value that is |
| 1150 | yields the form itself: | 1159 | almost 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 | ||
| 1157 | Note that when evaluating under lexical binding the result is a | 1166 | When evaluating under lexical binding the result is a similar |
| 1158 | closure object (@pxref{Closures}). | 1167 | closure object, where the @code{:dynbind} marker is replaced by the |
| 1168 | captured variables (@pxref{Closures}). | ||
| 1159 | 1169 | ||
| 1160 | The @code{lambda} form has one other effect: it tells the Emacs | 1170 | The @code{lambda} form has one other effect: it tells the Emacs |
| 1161 | evaluator and byte-compiler that its argument is a function, by using | 1171 | 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 | |||
| 1164 | 1174 | ||
| 1165 | @defspec function function-object | 1175 | @defspec function function-object |
| 1166 | @cindex function quoting | 1176 | @cindex function quoting |
| 1167 | This special form returns @var{function-object} without evaluating it. | 1177 | This special form returns the function value of the @var{function-object}. |
| 1168 | In this, it is similar to @code{quote} (@pxref{Quoting}). But unlike | 1178 | In 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 |
| 1170 | byte-compiler that @var{function-object} is intended to be used as a | 1180 | byte-compiler that @var{function-object} is intended to be used as a |
| 1171 | function. Assuming @var{function-object} is a valid lambda | 1181 | 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 | |||
| 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 |
| 1465 | code (@pxref{Byte Compilation}). Internally, a byte-code function | 1465 | definition into a function value. Closures are used both for |
| 1466 | object is much like a vector; however, the evaluator handles this data | 1466 | byte-compiled Lisp functions as well as for interpreted Lisp functions. |
| 1467 | type specially when it appears in a function call. @xref{Byte-Code | 1467 | Closures can be produced by byte-compiling Lisp code (@pxref{Byte |
| 1468 | Objects}. | 1468 | Compilation}) or simply by evaluating a lambda expression without |
| 1469 | compiling it, resulting in an interpreted function. Internally, | ||
| 1470 | a closure is much like a vector; however, the evaluator | ||
| 1471 | handles this data type specially when it appears in a function call. | ||
| 1472 | @xref{Closure Objects}. | ||
| 1469 | 1473 | ||
| 1470 | The printed representation and read syntax for a byte-code function | 1474 | The printed representation and read syntax for a byte-code function |
| 1471 | object is like that for a vector, with an additional @samp{#} before the | 1475 | object is like that for a vector, with an additional @samp{#} before the |
| 1472 | opening @samp{[}. | 1476 | opening @samp{[}. When printed for human consumption, it is printed as |
| 1477 | a 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 | ||
| 1584 | The @code{vconcat} function also allows byte-code function objects as | 1584 | The @code{vconcat} function also allows byte-code function objects as |
| 1585 | arguments. This is a special feature to make it easy to access the entire | 1585 | arguments. This is a special feature to make it easy to access the entire |
| 1586 | contents of a byte-code function object. @xref{Byte-Code Objects}. | 1586 | contents of a byte-code function object. @xref{Closure Objects}. |
| 1587 | 1587 | ||
| 1588 | For other concatenation functions, see @code{mapconcat} in @ref{Mapping | 1588 | For other concatenation functions, see @code{mapconcat} in @ref{Mapping |
| 1589 | Functions}, @code{concat} in @ref{Creating Strings}, and @code{append} | 1589 | Functions}, @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) |
| @@ -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'. | ||
| 1745 | Instead of representing interpreted functions as lists that start with | ||
| 1746 | either 'lambda' or 'closure', Emacs now represents them as objects | ||
| 1747 | of their own 'interpreted-function' type, which is very similar | ||
| 1748 | to 'byte-code-function' objects (the argument list, docstring, and | ||
| 1749 | interactive forms are placed in the same slots). | ||
| 1750 | Lists that start with 'lambda' are now used only for non-evaluated | ||
| 1751 | functions (in other words, for source code), but for backward compatibility | ||
| 1752 | reasons, 'functionp' still recognizes them as functions and you can | ||
| 1753 | still call them as before. | ||
| 1754 | Thus code that attempts to "dig" into the internal structure of an | ||
| 1755 | interpreted function's object with the likes of 'car' or 'cdr' will | ||
| 1756 | no longer work and will need to use 'aref' used instead to extract its | ||
| 1757 | various 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'. |
| 1745 | Minor modes defined with 'define-globalized-minor-mode', such as | 1762 | Minor 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, | ||
| 1901 | and 'closure' is the common parent type of 'interpreted-function' | ||
| 1902 | and 'byte-code-function'. | ||
| 1903 | Those 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'. |
| 1883 | For named functions, it just returns the name and otherwise | 1908 | For named functions, it just returns the name and otherwise |
| 1884 | it returns a short "unique" string that identifies the function. | 1909 | it 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. |
| 2902 | FUN should be an interpreted closure." | 2902 | FUN 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. |
| 907 | This is intended to be called at runtime by the ELisp interpreter (when | 907 | This is intended to be called at runtime by the ELisp interpreter (when |
| 908 | the code has not been compiled). | 908 | the code has not been compiled). |
| @@ -911,22 +911,27 @@ ENV is the runtime representation of the lexical environment, | |||
| 911 | i.e. a list whose elements can be either plain symbols (which indicate | 911 | i.e. a list whose elements can be either plain symbols (which indicate |
| 912 | that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE) | 912 | that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE) |
| 913 | for the lexical bindings." | 913 | for 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. | ||
| 449 | You can access the object's internals with `aref'. | ||
| 450 | The 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. |
| 434 | This has 2 uses: | 434 | This is used as a marker which cconv uses to check that |
| 435 | - For interpreted code, this converts the representation of type information | 435 | immutable 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 | ||
| 523 | DEFUN ("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 | |||
| 521 | DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, | 533 | DEFUN ("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 | |||
| 543 | DEFUN ("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 | ||
| 513 | DEFUN ("make-interpreted-closure", Fmake_interpreted_closure, | ||
| 514 | Smake_interpreted_closure, 3, 5, 0, | ||
| 515 | doc: /* Make an interpreted closure. | ||
| 516 | ARGS should be the list of formal arguments. | ||
| 517 | BODY should be a non-empty list of forms. | ||
| 518 | ENV should be a lexical environment, like the second argument of `eval'. | ||
| 519 | IFORM 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 | |||
| 513 | DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, | 540 | DEFUN ("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. |
| 515 | In byte compilation, `function' causes its argument to be handled by | 542 | In 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 | ||