diff options
| author | Stefan Monnier | 2024-03-11 16:12:26 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2024-04-18 15:28:36 -0400 |
| commit | 126be02077520a943252d0d219bb7677466d0168 (patch) | |
| tree | f762237714f11b303c708f93f09a8dc72426bb2a /lisp/emacs-lisp/oclosure.el | |
| parent | 7842af6095db4384898725fb4a14ebaa11379a34 (diff) | |
| download | emacs-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.
Diffstat (limited to 'lisp/emacs-lisp/oclosure.el')
| -rw-r--r-- | lisp/emacs-lisp/oclosure.el | 96 |
1 files changed, 39 insertions, 57 deletions
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: |