#70368 - [PATCH] Use a dedicated type to represent interpreted-function values

GNU bug report logs - #70368
[PATCH] Use a dedicated type to represent interpreted-function values

Package: emacs;

Reported by: Stefan Monnier <monnier <at> iro.umontreal.ca>

Date: Sat, 13 Apr 2024 19:58:03 UTC

Severity: normal

Tags: patch

Done: Stefan Monnier <monnier <at> iro.umontreal.ca>

Bug is archived. No further changes may be made.

View this message in rfc822 format

From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 70368 <at> debbugs.gnu.org Subject: bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values Date: Thu, 18 Apr 2024 12:36:36 -0400

[Message part 1 (text/plain, inline)]

OK, I've updated my patch according to your suggestions, see the result below (and in the `scratch/interpreted-function` branch). Any further comment/objection? Stefan

From 7842af6095db4384898725fb4a14ebaa11379a34 Mon Sep 17 00:00:00 2001 From: Stefan Monnier <monnier <at> iro.umontreal.ca> Date: Sun, 24 Mar 2024 18:32:25 -0400 Subject: [PATCH 1/2] (COMPILED): Rename to CLOSURE In preparation for the use of `PVEC_COMPILED` objects for interpreted functions, rename them to use a more neutral name. * src/lisp.h (enum pvec_type): Rename `PVEC_COMPILED` to `PVEC_CLOSURE`. (enum Lisp_Compiled): Use `CLOSURE_` prefix i.s.o `COMPILED_`. Also use `CODE` rather than `BYTECODE`. (CLOSUREP): Rename from `COMPILEDP`. (enum Lisp_Closure): Rename from `Lisp_Compiled`. * src/alloc.c, src/bytecode.c, src/comp.c, src/data.c, src/eval.c, * src/fns.c, src/lisp.h, src/lread.c, src/pdumper.c, src/print.c, * src/profiler.c: Rename all uses accordingly. * src/.gdbinit (xclosure): Rename from `xcompiled`. (xcompiled): New obsolete alias. (xpr): Adjust accordingly. Also adjust to new PVEC_CLOSURE tag name. --- src/.gdbinit | 17 ++++++++++++----- src/alloc.c | 40 ++++++++++++++++++++-------------------- src/bytecode.c | 20 ++++++++++---------- src/comp.c | 2 +- src/data.c | 22 +++++++++++----------- src/eval.c | 26 +++++++++++++------------- src/fns.c | 14 +++++++------- src/lisp.h | 22 +++++++++++----------- src/lread.c | 40 ++++++++++++++++++++-------------------- src/pdumper.c | 2 +- src/print.c | 6 +++--- src/profiler.c | 6 +++--- 12 files changed, 112 insertions(+), 105 deletions(-) diff --git a/src/.gdbinit b/src/.gdbinit index 6c4dda67f06..7645d466a5e 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -822,15 +822,22 @@ Print $ as a frame pointer. This command assumes $ is an Emacs Lisp frame value. end -define xcompiled +define xclosure xgetptr $ print (struct Lisp_Vector *) $ptr output ($->contents[0])@($->header.size & 0xff) echo \n end +document xclosure +Print $ as a function pointer. +This command assumes that $ is an Emacs Lisp byte-code or interpreted function value. +end + +define xcompiled + xclosure +end document xcompiled -Print $ as a compiled function pointer. -This command assumes that $ is an Emacs Lisp compiled value. +Obsolete alias for "xclosure". end define xwindow @@ -1038,8 +1045,8 @@ define xpr if $vec == PVEC_FRAME xframe end - if $vec == PVEC_COMPILED - xcompiled + if $vec == PVEC_CLOSURE + xclosure end if $vec == PVEC_WINDOW xwindow diff --git a/src/alloc.c b/src/alloc.c index 6779d0ca9ce..a8dfde56739 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3481,7 +3481,7 @@ cleanup_vector (struct Lisp_Vector *vector) case PVEC_XWIDGET_VIEW: case PVEC_TS_NODE: case PVEC_SQLITE: - case PVEC_COMPILED: + case PVEC_CLOSURE: case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: case PVEC_RECORD: @@ -3813,17 +3813,17 @@ and (optional) INTERACTIVE-SPEC. usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - if (! ((FIXNUMP (args[COMPILED_ARGLIST]) - || CONSP (args[COMPILED_ARGLIST]) - || NILP (args[COMPILED_ARGLIST])) - && STRINGP (args[COMPILED_BYTECODE]) - && !STRING_MULTIBYTE (args[COMPILED_BYTECODE]) - && VECTORP (args[COMPILED_CONSTANTS]) - && FIXNATP (args[COMPILED_STACK_DEPTH]))) + if (! ((FIXNUMP (args[CLOSURE_ARGLIST]) + || CONSP (args[CLOSURE_ARGLIST]) + || NILP (args[CLOSURE_ARGLIST])) + && STRINGP (args[CLOSURE_CODE]) + && !STRING_MULTIBYTE (args[CLOSURE_CODE]) + && VECTORP (args[CLOSURE_CONSTANTS]) + && FIXNATP (args[CLOSURE_STACK_DEPTH]))) error ("Invalid byte-code object"); /* Bytecode must be immovable. */ - pin_string (args[COMPILED_BYTECODE]); + pin_string (args[CLOSURE_CODE]); /* We used to purecopy everything here, if purify-flag was set. This worked OK for Emacs-23, but with Emacs-24's lexical binding code, it can be @@ -3833,7 +3833,7 @@ and (optional) INTERACTIVE-SPEC. just wasteful and other times plainly wrong (e.g. those free vars may want to be setcar'd). */ Lisp_Object val = Fvector (nargs, args); - XSETPVECTYPE (XVECTOR (val), PVEC_COMPILED); + XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE); return val; } @@ -3845,12 +3845,12 @@ DEFUN ("make-closure", Fmake_closure, Smake_closure, 1, MANY, 0, (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object protofun = args[0]; - CHECK_TYPE (COMPILEDP (protofun), Qbyte_code_function_p, protofun); + CHECK_TYPE (CLOSUREP (protofun), Qbyte_code_function_p, protofun); /* Create a copy of the constant vector, filling it with the closure variables in the beginning. (The overwritten part should just contain placeholder values.) */ - Lisp_Object proto_constvec = AREF (protofun, COMPILED_CONSTANTS); + Lisp_Object proto_constvec = AREF (protofun, CLOSURE_CONSTANTS); ptrdiff_t constsize = ASIZE (proto_constvec); ptrdiff_t nvars = nargs - 1; if (nvars > constsize) @@ -3866,7 +3866,7 @@ DEFUN ("make-closure", Fmake_closure, Smake_closure, 1, MANY, 0, struct Lisp_Vector *v = allocate_vectorlike (protosize, false); v->header = XVECTOR (protofun)->header; memcpy (v->contents, XVECTOR (protofun)->contents, protosize * word_size); - v->contents[COMPILED_CONSTANTS] = constvec; + v->contents[CLOSURE_CONSTANTS] = constvec; return make_lisp_ptr (v, Lisp_Vectorlike); } @@ -6046,7 +6046,7 @@ purecopy (Lisp_Object obj) obj = make_lisp_hash_table (purecopy_hash_table (table)); } - else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj)) + else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj)) { struct Lisp_Vector *objp = XVECTOR (obj); ptrdiff_t nbytes = vector_nbytes (objp); @@ -6059,7 +6059,7 @@ purecopy (Lisp_Object obj) for (i = 0; i < size; i++) vec->contents[i] = purecopy (vec->contents[i]); /* Byte code strings must be pinned. */ - if (COMPILEDP (obj) && size >= 2 && STRINGP (vec->contents[1]) + if (CLOSUREP (obj) && size >= 2 && STRINGP (vec->contents[1]) && !STRING_MULTIBYTE (vec->contents[1])) pin_string (vec->contents[1]); XSETVECTOR (obj, vec); @@ -8014,11 +8014,11 @@ symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj) return (EQ (val, obj) || EQ (sym->u.s.function, obj) || (!NILP (sym->u.s.function) - && COMPILEDP (sym->u.s.function) - && EQ (AREF (sym->u.s.function, COMPILED_BYTECODE), obj)) + && CLOSUREP (sym->u.s.function) + && EQ (AREF (sym->u.s.function, CLOSURE_CODE), obj)) || (!NILP (val) - && COMPILEDP (val) - && EQ (AREF (val, COMPILED_BYTECODE), obj))); + && CLOSUREP (val) + && EQ (AREF (val, CLOSURE_CODE), obj))); } /* Find at most FIND_MAX symbols which have OBJ as their value or @@ -8343,7 +8343,7 @@ syms_of_alloc (void) enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE; enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE; enum Lisp_Bits Lisp_Bits; - enum Lisp_Compiled Lisp_Compiled; + enum Lisp_Closure Lisp_Closure; enum maxargs maxargs; enum MAX_ALLOCA MAX_ALLOCA; enum More_Lisp_Bits More_Lisp_Bits; diff --git a/src/bytecode.c b/src/bytecode.c index de25069d94a..03443ed54ab 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -479,7 +479,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object *top = NULL; unsigned char const *pc = NULL; - Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + Lisp_Object bytestr = AREF (fun, CLOSURE_CODE); setup_frame: ; eassert (!STRING_MULTIBYTE (bytestr)); @@ -489,8 +489,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, when returning, to detect unwind imbalances. This would require adding a field to the frame header. */ - Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); - Lisp_Object maxdepth = AREF (fun, COMPILED_STACK_DEPTH); + Lisp_Object vector = AREF (fun, CLOSURE_CONSTANTS); + Lisp_Object maxdepth = AREF (fun, CLOSURE_STACK_DEPTH); ptrdiff_t const_length = ASIZE (vector); ptrdiff_t bytestr_length = SCHARS (bytestr); Lisp_Object *vectorp = XVECTOR (vector)->contents; @@ -792,14 +792,14 @@ #define DEFINE(name, value) [name] = &&insn_ ## name, /* Calls to symbols-with-pos don't need to be on the fast path. */ if (BARE_SYMBOL_P (call_fun)) call_fun = XBARE_SYMBOL (call_fun)->u.s.function; - if (COMPILEDP (call_fun)) + if (CLOSUREP (call_fun)) { - Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST); + Lisp_Object template = AREF (call_fun, CLOSURE_ARGLIST); if (FIXNUMP (template)) { /* Fast path for lexbound functions. */ fun = call_fun; - bytestr = AREF (call_fun, COMPILED_BYTECODE), + bytestr = AREF (call_fun, CLOSURE_CODE), args_template = XFIXNUM (template); nargs = call_nargs; args = call_args; @@ -897,8 +897,8 @@ #define DEFINE(name, value) [name] = &&insn_ ## name, bc->fp = fp; Lisp_Object fun = fp->fun; - Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); - Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + Lisp_Object bytestr = AREF (fun, CLOSURE_CODE); + Lisp_Object vector = AREF (fun, CLOSURE_CONSTANTS); bytestr_data = SDATA (bytestr); vectorp = XVECTOR (vector)->contents; if (BYTE_CODE_SAFE) @@ -974,8 +974,8 @@ #define DEFINE(name, value) [name] = &&insn_ ## name, struct bc_frame *fp = bc->fp; Lisp_Object fun = fp->fun; - Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); - Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + Lisp_Object bytestr = AREF (fun, CLOSURE_CODE); + Lisp_Object vector = AREF (fun, CLOSURE_CONSTANTS); bytestr_data = SDATA (bytestr); vectorp = XVECTOR (vector)->contents; if (BYTE_CODE_SAFE) diff --git a/src/comp.c b/src/comp.c index 99f51e07048..d2115de522c 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5199,7 +5199,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, if (!native_comp_jit_compilation || noninteractive || !NILP (Vpurify_flag) - || !COMPILEDP (definition) + || !CLOSUREP (definition) || !STRINGP (Vload_true_file_name) || !suffix_p (Vload_true_file_name, ".elc") || !NILP (Fgethash (Vload_true_file_name, V_comp_no_native_file_h, Qnil))) diff --git a/src/data.c b/src/data.c index c4b9cff8ae0..681054ff8cb 100644 --- a/src/data.c +++ b/src/data.c @@ -248,7 +248,7 @@ DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0, return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp : Qprimitive_function; - case PVEC_COMPILED: return Qcompiled_function; + case PVEC_CLOSURE: return Qcompiled_function; case PVEC_BUFFER: return Qbuffer; case PVEC_CHAR_TABLE: return Qchar_table; case PVEC_BOOL_VECTOR: return Qbool_vector; @@ -523,7 +523,7 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, doc: /* Return t if OBJECT is a byte-compiled function object. */) (Lisp_Object object) { - if (COMPILEDP (object)) + if (CLOSUREP (object)) return Qt; return Qnil; } @@ -1143,19 +1143,19 @@ DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, (*spec != '(') ? build_string (spec) : Fcar (Fread_from_string (build_string (spec), Qnil, Qnil))); } - else if (COMPILEDP (fun)) + else if (CLOSUREP (fun)) { - if (PVSIZE (fun) > COMPILED_INTERACTIVE) + if (PVSIZE (fun) > CLOSURE_INTERACTIVE) { - Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); + Lisp_Object form = AREF (fun, CLOSURE_INTERACTIVE); /* The vector form is the new form, where the first element is the interactive spec, and the second is the command modes. */ return list2 (Qinteractive, VECTORP (form) ? AREF (form, 0) : form); } - else if (PVSIZE (fun) > COMPILED_DOC_STRING) + else if (PVSIZE (fun) > CLOSURE_DOC_STRING) { - Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING); + Lisp_Object doc = AREF (fun, CLOSURE_DOC_STRING); /* An invalid "docstring" is a sign that we have an OClosure. */ genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc)); } @@ -1225,11 +1225,11 @@ DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0, { return XSUBR (fun)->command_modes; } - else if (COMPILEDP (fun)) + else if (CLOSUREP (fun)) { - if (PVSIZE (fun) <= COMPILED_INTERACTIVE) + if (PVSIZE (fun) <= CLOSURE_INTERACTIVE) return Qnil; - Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); + Lisp_Object form = AREF (fun, CLOSURE_INTERACTIVE); if (VECTORP (form)) /* New form -- the second element is the command modes. */ return AREF (form, 1); @@ -2546,7 +2546,7 @@ DEFUN ("aref", Faref, Saref, 2, 2, 0, ptrdiff_t size = 0; if (VECTORP (array)) size = ASIZE (array); - else if (COMPILEDP (array) || RECORDP (array)) + else if (CLOSUREP (array) || RECORDP (array)) size = PVSIZE (array); else wrong_type_argument (Qarrayp, array); diff --git a/src/eval.c b/src/eval.c index c5b8a375af4..a7d860114cf 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2151,15 +2151,15 @@ DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0, return Qt; } /* Bytecode objects are interactive if they are long enough to - have an element whose index is COMPILED_INTERACTIVE, which is + have an element whose index is CLOSURE_INTERACTIVE, which is where the interactive spec is stored. */ - else if (COMPILEDP (fun)) + else if (CLOSUREP (fun)) { - if (PVSIZE (fun) > COMPILED_INTERACTIVE) + if (PVSIZE (fun) > CLOSURE_INTERACTIVE) return Qt; - else if (PVSIZE (fun) > COMPILED_DOC_STRING) + else if (PVSIZE (fun) > CLOSURE_DOC_STRING) { - Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING); + Lisp_Object doc = AREF (fun, CLOSURE_DOC_STRING); /* An invalid "docstring" is a sign that we have an OClosure. */ genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc)); } @@ -2567,7 +2567,7 @@ eval_sub (Lisp_Object form) } } } - else if (COMPILEDP (fun) + else if (CLOSUREP (fun) || SUBR_NATIVE_COMPILED_DYNP (fun) || MODULE_FUNCTIONP (fun)) return apply_lambda (fun, original_args, count); @@ -2945,7 +2945,7 @@ FUNCTIONP (Lisp_Object object) if (SUBRP (object)) return XSUBR (object)->max_args != UNEVALLED; - else if (COMPILEDP (object) || MODULE_FUNCTIONP (object)) + else if (CLOSUREP (object) || MODULE_FUNCTIONP (object)) return true; else if (CONSP (object)) { @@ -2967,7 +2967,7 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) return funcall_subr (XSUBR (fun), numargs, args); - else if (COMPILEDP (fun) + else if (CLOSUREP (fun) || SUBR_NATIVE_COMPILED_DYNP (fun) || MODULE_FUNCTIONP (fun)) return funcall_lambda (fun, numargs, args); @@ -3181,9 +3181,9 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) else xsignal1 (Qinvalid_function, fun); } - else if (COMPILEDP (fun)) + else if (CLOSUREP (fun)) { - syms_left = AREF (fun, COMPILED_ARGLIST); + syms_left = AREF (fun, CLOSURE_ARGLIST); /* Bytecode objects using lexical binding have an integral ARGLIST slot value: pass the arguments to the byte-code engine directly. */ @@ -3315,7 +3315,7 @@ DEFUN ("func-arity", Ffunc_arity, Sfunc_arity, 1, 1, 0, if (SUBRP (function)) result = Fsubr_arity (function); - else if (COMPILEDP (function)) + else if (CLOSUREP (function)) result = lambda_arity (function); #ifdef HAVE_MODULES else if (MODULE_FUNCTIONP (function)) @@ -3363,9 +3363,9 @@ lambda_arity (Lisp_Object fun) else xsignal1 (Qinvalid_function, fun); } - else if (COMPILEDP (fun)) + else if (CLOSUREP (fun)) { - syms_left = AREF (fun, COMPILED_ARGLIST); + syms_left = AREF (fun, CLOSURE_ARGLIST); if (FIXNUMP (syms_left)) return get_byte_code_arity (syms_left); } diff --git a/src/fns.c b/src/fns.c index db5e856d5bd..e987d64319f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -152,7 +152,7 @@ DEFUN ("length", Flength, Slength, 1, 1, 0, val = MAX_CHAR; else if (BOOL_VECTOR_P (sequence)) val = bool_vector_size (sequence); - else if (COMPILEDP (sequence) || RECORDP (sequence)) + else if (CLOSUREP (sequence) || RECORDP (sequence)) val = PVSIZE (sequence); else wrong_type_argument (Qsequencep, sequence); @@ -1054,7 +1054,7 @@ concat_to_list (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail) else if (NILP (arg)) ; else if (VECTORP (arg) || STRINGP (arg) - || BOOL_VECTOR_P (arg) || COMPILEDP (arg)) + || BOOL_VECTOR_P (arg) || CLOSUREP (arg)) { ptrdiff_t arglen = XFIXNUM (Flength (arg)); ptrdiff_t argindex_byte = 0; @@ -1114,7 +1114,7 @@ concat_to_vector (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object arg = args[i]; if (!(VECTORP (arg) || CONSP (arg) || NILP (arg) || STRINGP (arg) - || BOOL_VECTOR_P (arg) || COMPILEDP (arg))) + || BOOL_VECTOR_P (arg) || CLOSUREP (arg))) wrong_type_argument (Qsequencep, arg); EMACS_INT len = XFIXNAT (Flength (arg)); result_len += len; @@ -1170,7 +1170,7 @@ concat_to_vector (ptrdiff_t nargs, Lisp_Object *args) } else { - eassert (COMPILEDP (arg)); + eassert (CLOSUREP (arg)); ptrdiff_t size = PVSIZE (arg); memcpy (dst, XVECTOR (arg)->contents, size * sizeof *dst); dst += size; @@ -2949,7 +2949,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, if (size & PSEUDOVECTOR_FLAG) { if (((size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS) - < PVEC_COMPILED) + < PVEC_CLOSURE) return false; size &= PSEUDOVECTOR_SIZE_MASK; } @@ -3346,7 +3346,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) tail = XCDR (tail); } } - else if (VECTORP (seq) || COMPILEDP (seq)) + else if (VECTORP (seq) || CLOSUREP (seq)) { for (ptrdiff_t i = 0; i < leni; i++) { @@ -5512,7 +5512,7 @@ sxhash_obj (Lisp_Object obj, int depth) case Lisp_Vectorlike: { enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj)); - if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED)) + if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_CLOSURE)) { /* According to the CL HyperSpec, two arrays are equal only if they are 'eq', except for strings and bit-vectors. In diff --git a/src/lisp.h b/src/lisp.h index 3cb4361e75e..526248dd2ba 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1049,7 +1049,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) PVEC_SQLITE, /* These should be last, for internal_equal and sxhash_obj. */ - PVEC_COMPILED, + PVEC_CLOSURE, PVEC_CHAR_TABLE, PVEC_SUB_CHAR_TABLE, PVEC_RECORD, @@ -3223,16 +3223,16 @@ XFLOAT_DATA (Lisp_Object f) #define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) -/* Meanings of slots in a Lisp_Compiled: */ +/* Meanings of slots in a Lisp_Closure: */ -enum Lisp_Compiled +enum Lisp_Closure { - COMPILED_ARGLIST = 0, - COMPILED_BYTECODE = 1, - COMPILED_CONSTANTS = 2, - COMPILED_STACK_DEPTH = 3, - COMPILED_DOC_STRING = 4, - COMPILED_INTERACTIVE = 5 + CLOSURE_ARGLIST = 0, + CLOSURE_CODE = 1, + CLOSURE_CONSTANTS = 2, + CLOSURE_STACK_DEPTH = 3, + CLOSURE_DOC_STRING = 4, + CLOSURE_INTERACTIVE = 5 }; /* Flag bits in a character. These also get used in termhooks.h. @@ -3307,9 +3307,9 @@ WINDOW_CONFIGURATIONP (Lisp_Object a) } INLINE bool -COMPILEDP (Lisp_Object a) +CLOSUREP (Lisp_Object a) { - return PSEUDOVECTORP (a, PVEC_COMPILED); + return PSEUDOVECTORP (a, PVEC_CLOSURE); } INLINE bool diff --git a/src/lread.c b/src/lread.c index 09a5589fd0c..8b614e6220e 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3498,52 +3498,52 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) Lisp_Object *vec = XVECTOR (obj)->contents; ptrdiff_t size = ASIZE (obj); - if (infile && size >= COMPILED_CONSTANTS) + if (infile && size >= CLOSURE_CONSTANTS) { /* Always read 'lazily-loaded' bytecode (generated by the `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to avoid code in the fast path during execution. */ - if (CONSP (vec[COMPILED_BYTECODE]) - && FIXNUMP (XCDR (vec[COMPILED_BYTECODE]))) - vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); + if (CONSP (vec[CLOSURE_CODE]) + && FIXNUMP (XCDR (vec[CLOSURE_CODE]))) + vec[CLOSURE_CODE] = get_lazy_string (vec[CLOSURE_CODE]); /* Lazily-loaded bytecode is represented by the constant slot being nil and the bytecode slot a (lazily loaded) string containing the print representation of (BYTECODE . CONSTANTS). Unpack the pieces by coerceing the string to unibyte and reading the result. */ - if (NILP (vec[COMPILED_CONSTANTS]) && STRINGP (vec[COMPILED_BYTECODE])) + if (NILP (vec[CLOSURE_CONSTANTS]) && STRINGP (vec[CLOSURE_CODE])) { - Lisp_Object enc = vec[COMPILED_BYTECODE]; + Lisp_Object enc = vec[CLOSURE_CODE]; Lisp_Object pair = Fread (Fcons (enc, readcharfun)); if (!CONSP (pair)) invalid_syntax ("Invalid byte-code object", readcharfun); - vec[COMPILED_BYTECODE] = XCAR (pair); - vec[COMPILED_CONSTANTS] = XCDR (pair); + vec[CLOSURE_CODE] = XCAR (pair); + vec[CLOSURE_CONSTANTS] = XCDR (pair); } } - if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1 - && (FIXNUMP (vec[COMPILED_ARGLIST]) - || CONSP (vec[COMPILED_ARGLIST]) - || NILP (vec[COMPILED_ARGLIST])) - && STRINGP (vec[COMPILED_BYTECODE]) - && VECTORP (vec[COMPILED_CONSTANTS]) - && FIXNATP (vec[COMPILED_STACK_DEPTH]))) + if (!(size >= CLOSURE_STACK_DEPTH + 1 && size <= CLOSURE_INTERACTIVE + 1 + && (FIXNUMP (vec[CLOSURE_ARGLIST]) + || CONSP (vec[CLOSURE_ARGLIST]) + || NILP (vec[CLOSURE_ARGLIST])) + && STRINGP (vec[CLOSURE_CODE]) + && VECTORP (vec[CLOSURE_CONSTANTS]) + && FIXNATP (vec[CLOSURE_STACK_DEPTH]))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) + if (STRING_MULTIBYTE (vec[CLOSURE_CODE])) /* BYTESTR must have been produced by Emacs 20.2 or earlier because it produced a raw 8-bit string for byte-code and now such a byte-code string is loaded as multibyte with raw 8-bit characters converted to multibyte form. Convert them back to the original unibyte form. */ - vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); + vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]); /* Bytecode must be immovable. */ - pin_string (vec[COMPILED_BYTECODE]); + pin_string (vec[CLOSURE_CODE]); - XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED); + XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE); return obj; } @@ -4678,7 +4678,7 @@ substitute_object_recurse (struct subst *subst, Lisp_Object subtree) if (BOOL_VECTOR_P (subtree)) return subtree; /* No sub-objects anyway. */ else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree) - || COMPILEDP (subtree) || HASH_TABLE_P (subtree) + || CLOSUREP (subtree) || HASH_TABLE_P (subtree) || RECORDP (subtree)) length = PVSIZE (subtree); else if (VECTORP (subtree)) diff --git a/src/pdumper.c b/src/pdumper.c index ac8bf6f31f4..2963efc56ab 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -3068,7 +3068,7 @@ dump_vectorlike (struct dump_context *ctx, error_unsupported_dump_object(ctx, lv, "font"); FALLTHROUGH; case PVEC_NORMAL_VECTOR: - case PVEC_COMPILED: + case PVEC_CLOSURE: case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: case PVEC_RECORD: diff --git a/src/print.c b/src/print.c index 0d867b89395..612d63b7e94 100644 --- a/src/print.c +++ b/src/print.c @@ -1299,7 +1299,7 @@ #define PRINT_CIRCLE_CANDIDATE_P(obj) \ (STRINGP (obj) \ || CONSP (obj) \ || (VECTORLIKEP (obj) \ - && (VECTORP (obj) || COMPILEDP (obj) \ + && (VECTORP (obj) || CLOSUREP (obj) \ || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \ || HASH_TABLE_P (obj) || FONTP (obj) \ || RECORDP (obj))) \ @@ -2091,7 +2091,7 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun, /* Types handled earlier. */ case PVEC_NORMAL_VECTOR: case PVEC_RECORD: - case PVEC_COMPILED: + case PVEC_CLOSURE: case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: case PVEC_HASH_TABLE: @@ -2559,7 +2559,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_stack_push_vector ("#s(", ")", obj, 0, PVSIZE (obj), printcharfun); goto next_obj; - case PVEC_COMPILED: + case PVEC_CLOSURE: print_stack_push_vector ("#[", "]", obj, 0, PVSIZE (obj), printcharfun); goto next_obj; diff --git a/src/profiler.c b/src/profiler.c index 5a6a8b48f6b..ac23a97b672 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -170,7 +170,7 @@ trace_hash (Lisp_Object *trace, int depth) { Lisp_Object f = trace[i]; EMACS_UINT hash1 - = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE)) + = (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE)) : (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f))) ? XHASH (XCDR (XCDR (f))) : XHASH (f)); hash = sxhash_combine (hash, hash1); @@ -675,8 +675,8 @@ DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0, bool res; if (EQ (f1, f2)) res = true; - else if (COMPILEDP (f1) && COMPILEDP (f2)) - res = EQ (AREF (f1, COMPILED_BYTECODE), AREF (f2, COMPILED_BYTECODE)); + else if (CLOSUREP (f1) && CLOSUREP (f2)) + res = EQ (AREF (f1, CLOSURE_CODE), AREF (f2, CLOSURE_CODE)); else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2)) && EQ (Qclosure, XCAR (f1)) && EQ (Qclosure, XCAR (f2))) -- 2.43.0

From bbe7837f7da0ad0167d2d1dcd032c90dcfe11bf4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier <monnier <at> iro.umontreal.ca> Date: Mon, 11 Mar 2024 16:12:26 -0400 Subject: [PATCH 2/2] Use a dedicated type to represent interpreted-function values Change `function` so that when evaluating #'(lambda ...) we return an object of type `interpreted-function` rather than a list starting with one of `lambda` or `closure`. The new type reuses the existing PVEC_CLOSURE (nee PVEC_COMPILED) tag and tries to align the corresponding elements: - the arglist, the docstring, and the interactive-form go in the same slots as for byte-code functions. - the body of the function goes in the slot used for the bytecode string. - the lexical context goes in the slot used for the constants of bytecoded functions. The first point above means that `help-function-arglist`, `documentation`, and `interactive-form`s don't need to distinguish interpreted and bytecode functions any more. Main benefits of the change: - We can now reliably distinguish a list from a function value. - `cl-defmethod` can dispatch on `interactive-function` and `closure`. Dispatch on `function` also works now for interpreted functions but still won't work for functions represented as lists or as symbols, of course. - Function values are now self-evaluating. That was alrready the case when byte-compiled, but not when interpreted since (eval '(closure ...)) signals a void-function error. That also avoids false-positive warnings about "don't quote your lambdas" when doing things like `(mapcar ',func ...)`. * src/eval.c (Fmake_interpreted_closure): New function. (Ffunction): Use it and change calling convention of `Vinternal_make_interpreted_closure_function`. (FUNCTIONP, Fcommandp, eval_sub, funcall_general, funcall_lambda) (Ffunc_arity, lambda_arity): Simplify. (funcall_lambda): Adjust to new representation. (syms_of_eval): `defsubr` the new function. Remove definition of `Qclosure`. * lisp/emacs-lisp/cconv.el (cconv-make-interpreted-closure): Change calling convention and use `make-interpreted-closure`. * src/data.c (Fcl_type_of): Distinguish `byte-code-function`s from `interpreted-function`s. (Fclosurep, finterpreted_function_p): New functions. (Fbyte_code_function_p): Don't be confused by `interpreted-function`s. (Finteractive_form, Fcommand_modes): Simplify. (syms_of_data): Define new type symbols and `defsubr` the two new functions. * lisp/emacs-lisp/cl-print.el (cl-print-object) <interpreted-function>: New method. * lisp/emacs-lisp/oclosure.el (oclosure): Refine the parent to be `closure`. (oclosure--fix-type, oclosure-type): Simplify. (oclosure--copy, oclosure--get, oclosure--set): Adjust to new representation. * src/callint.c (Fcall_interactively): Adjust to new representation. * src/lread.c (bytecode_from_rev_list): * lisp/simple.el (function-documentation): * lisp/help.el (help-function-arglist): Remove the old `closure` case and adjust the byte-code case so it handles `interpreted-function`s. * lisp/emacs-lisp/cl-preloaded.el (closure): New type. (byte-code-function): Add it as a parent. (interpreted-function): Adjust parent (the type itself was already added earlier by accident). * lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Adjust to new representation. (byte-compile): Use `interpreted-function-p`. * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Adjust to new representation. (side-effect-free-fns): Add `interpreted-function-p` and `closurep`. * src/profiler.c (trace_hash, ffunction_equal): Simplify. * lisp/profiler.el (profiler-function-equal): Simplify. * lisp/emacs-lisp/nadvice.el (advice--interactive-form-1): Use `interpreted-function-p`; adjust to new representation; and take advantage of the fact that function values are now self-evaluating. * lisp/emacs-lisp/lisp-mode.el (closure): Remove `lisp-indent-function` property. * lisp/emacs-lisp/disass.el (disassemble-internal): Adjust to new representation. * lisp/emacs-lisp/edebug.el (edebug--strip-instrumentation): Use `interpreted-function-p`. * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): Add `closurep` and `interpreted-function-p`. * test/lisp/help-fns-tests.el (help-fns-test-lisp-defun): Adjust to more precise type info in `describe-function`. * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d--render-entries): Use `interpreted-function-p`. * test/lisp/emacs-lisp/macroexp-resources/vk.el (vk-f4, vk-f5): Don't hardcode function values. * doc/lispref/functions.texi (Anonymous Functions): Don't suggest that function values are lists. Reword "self-quoting" to reflect the fact that #' doesn't return the exact same object. Update examples with the new shape of the return value. * doc/lispref/variables.texi (Lexical Binding): * doc/lispref/lists.texi (Rearrangement): * doc/lispref/control.texi (Handling Errors): Update examples to reflect new representation of function values. --- doc/lispref/compile.texi | 61 +++++--- doc/lispref/control.texi | 2 +- doc/lispref/elisp.texi | 4 +- doc/lispref/functions.texi | 36 +++-- doc/lispref/lists.texi | 4 +- doc/lispref/objects.texi | 38 +++-- doc/lispref/sequences.texi | 2 +- doc/lispref/variables.texi | 2 +- etc/NEWS | 17 ++ lisp/emacs-lisp/byte-opt.el | 3 +- lisp/emacs-lisp/bytecomp.el | 18 ++- lisp/emacs-lisp/cconv.el | 38 +++-- lisp/emacs-lisp/cl-preloaded.el | 15 +- lisp/emacs-lisp/cl-print.el | 32 ++++ lisp/emacs-lisp/comp-common.el | 2 + lisp/emacs-lisp/disass.el | 6 +- lisp/emacs-lisp/edebug.el | 2 +- lisp/emacs-lisp/lisp-mode.el | 1 - lisp/emacs-lisp/nadvice.el | 6 +- lisp/emacs-lisp/oclosure.el | 96 +++++------- lisp/help.el | 3 +- lisp/profiler.el | 5 +- lisp/simple.el | 5 +- src/callint.c | 6 +- src/data.c | 46 ++++-- src/eval.c | 147 +++++++++++------- src/lread.c | 35 +++-- src/profiler.c | 8 +- test/lisp/emacs-lisp/macroexp-resources/vk.el | 48 +++--- test/lisp/erc/resources/erc-d/erc-d-tests.el | 5 +- test/lisp/help-fns-tests.el | 10 +- 31 files changed, 428 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 @@ Byte Compilation * Docs and Compilation:: Dynamic loading of documentation strings. * Eval During Compile:: Code to be evaluated when you compile. * Compiler Errors:: Handling compiler error messages. -* Byte-Code Objects:: The data type used for byte-compiled functions. +* Closure Objects:: The data type used for byte-compiled functions. * Disassembly:: Disassembling byte-code; how to read byte-code. @end menu @@ -120,7 +120,7 @@ Compilation Functions definition of @var{symbol} must be the actual code for the function; @code{byte-compile} does not handle function indirection. The return value is the byte-code function object which is the compiled -definition of @var{symbol} (@pxref{Byte-Code Objects}). +definition of @var{symbol} (@pxref{Closure Objects}). @example @group @@ -487,21 +487,22 @@ Compiler Errors using @code{error}. If so, set @code{byte-compile-error-on-warn} to a non-@code{nil} value. -@node Byte-Code Objects -@section Byte-Code Function Objects +@node Closure Objects +@section Closure Function Objects @cindex compiled function @cindex byte-code function @cindex byte-code object - Byte-compiled functions have a special data type: they are -@dfn{byte-code function objects}. Whenever such an object appears as -a function to be called, Emacs uses the byte-code interpreter to -execute the byte-code. + Byte-compiled functions use a special data type: they are closures. +Closures are used both for byte-compiled Lisp functions as well as for +interpreted Lisp functions. Whenever such an object appears as +a function to be called, Emacs uses the appropriate interpreter to +execute either the byte-code or the non-compiled Lisp code. - Internally, a byte-code function object is much like a vector; its + Internally, a closure is much like a vector; its elements can be accessed using @code{aref}. Its printed representation is like that for a vector, with an additional @samp{#} -before the opening @samp{[}. It must have at least four elements; +before the opening @samp{[}. It must have at least three elements; there is no maximum number, but only the first six elements have any normal use. They are: @@ -515,20 +516,28 @@ Byte-Code Objects the argument list uses @code{&rest}, then bit 7 is set; otherwise it's cleared. -If @var{argdesc} is a list, the arguments will be dynamically bound +When the closure is a byte-code function, +if @var{argdesc} is a list, the arguments will be dynamically bound before executing the byte code. If @var{argdesc} is an integer, the arguments will be instead pushed onto the stack of the byte-code interpreter, before executing the code. -@item byte-code -The string containing the byte-code instructions. +@item code +For interpreted functions, this element is the (non-empty) list of Lisp +forms that make up the function's body. For byte-compiled functions, it +is the string containing the byte-code instructions. @item constants -The vector of Lisp objects referenced by the byte code. These include -symbols used as function names and variable names. +For byte-compiled functions, this holds the vector of Lisp objects +referenced by the byte code. These include symbols used as function +names and variable names. +For interpreted functions, this is @code{nil} if the function is using the old +dynamically scoped dialect of Emacs Lisp, and otherwise it holds the +function's lexical environment. @item stacksize -The maximum stack size this function needs. +The maximum stack size this function needs. This element is left unused +for interpreted functions. @item docstring The documentation string (if any); otherwise, @code{nil}. The value may @@ -558,8 +567,8 @@ Byte-Code Objects @code{make-byte-code}: @defun make-byte-code &rest elements -This function constructs and returns a byte-code function object -with @var{elements} as its elements. +This function constructs and returns a closure which represents the +byte-code function object with @var{elements} as its elements. @end defun You should not try to come up with the elements for a byte-code @@ -567,6 +576,20 @@ Byte-Code Objects when you call the function. Always leave it to the byte compiler to create these objects; it makes the elements consistent (we hope). +The primitive way to create an interpreted function is with +@code{make-interpreted-closure}: + +@defun make-interpreted-closure args body env &optional docstring iform +This function constructs and returns a closure representing the +interpreted function with arguments @var{args} and whose body is made of +@var{body} which must be a non-@code{nil} list of Lisp forms. @var{env} is the +lexical environment in the same form as used with @code{eval} +(@pxref{Eval}). The documentation @var{docstring} if non-@code{nil} should be +a string, and the interactive form @var{iform} if non-@code{nil} should be of +the form @w{@code{(interactive @var{arg-descriptor})}} (@pxref{Using +Interactive}). +@end defun + @node Disassembly @section Disassembled Byte-Code @cindex disassembled byte-code @@ -595,7 +618,7 @@ Disassembly point is left before the output. The argument @var{object} can be a function name, a lambda expression -(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Byte-Code +(@pxref{Lambda Expressions}), or a byte-code object (@pxref{Closure Objects}). If it is a lambda expression, @code{disassemble} compiles it and disassembles the resulting compiled code. @end deffn 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 @@ Handling Errors @group Debugger entered--Lisp error: (error "Oops") signal(error ("Oops")) - (closure (t) (err) (signal 'error (cdr err)))((user-error "Oops")) + #f(lambda (err) [t] (signal 'error (cdr err)))((user-error "Oops")) user-error("Oops") @dots{} eval((handler-bind ((user-error (lambda (err) @dots{} 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 @@ Top * Macro Type:: A method of expanding an expression into another expression, more fundamental but less pretty. * Primitive Function Type:: A function written in C, callable from Lisp. -* Byte-Code Type:: A function written in Lisp, then compiled. +* Closure Type:: A function written in Lisp, then compiled. * Record Type:: Compound objects with programmer-defined types. * Type Descriptors:: Objects holding information about types. * Autoload Type:: A type used for automatically loading seldom-used @@ -657,7 +657,7 @@ Top * Docs and Compilation:: Dynamic loading of documentation strings. * Eval During Compile:: Code to be evaluated when you compile. * Compiler Errors:: Handling compiler error messages. -* Byte-Code Objects:: The data type used for byte-compiled functions. +* Closure Objects:: The data type used for byte-compiled functions. * Disassembly:: Disassembling byte-code; how to read byte-code. Native Compilation 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 @@ What Is a Function @item byte-code function A function that has been compiled by the byte compiler. -@xref{Byte-Code Type}. +@xref{Closure Type}. @item autoload object @cindex autoload object @@ -227,6 +227,16 @@ What Is a Function a function loaded from a dynamic module (@pxref{Dynamic Modules}). @end defun +@defun interpreted-function-p object +This function returns @code{t} if @var{object} is an interpreted function. +@end defun + +@defun closurep object +This function returns @code{t} if @var{object} is a closure, which is +a particular kind of function object. Currently closures are used +for all byte-code functions and all interpreted functions. +@end defun + @defun subr-arity subr This works like @code{func-arity}, but only for built-in functions and without symbol indirection. It signals an error for non-built-in @@ -1136,8 +1146,7 @@ Anonymous Functions of this. When defining a lambda expression that is to be used as an anonymous -function, you can in principle use any method to construct the list. -But typically you should use the @code{lambda} macro, or the +function, you should use the @code{lambda} macro, or the @code{function} special form, or the @code{#'} read syntax: @defmac lambda args [doc] [interactive] body <at> dots{} @@ -1145,17 +1154,18 @@ Anonymous Functions @var{args}, documentation string @var{doc} (if any), interactive spec @var{interactive} (if any), and body forms given by @var{body}. -Under dynamic binding, this macro effectively makes @code{lambda} -forms self-quoting: evaluating a form whose @sc{car} is @code{lambda} -yields the form itself: +For example, this macro makes @code{lambda} forms almost self-quoting: +evaluating a form whose @sc{car} is @code{lambda} yields a value that is +almost like the form itself: @example (lambda (x) (* x x)) - @result{} (lambda (x) (* x x)) + @result{} #f(lambda (x) :dynbind (* x x)) @end example -Note that when evaluating under lexical binding the result is a -closure object (@pxref{Closures}). +When evaluating under lexical binding the result is a similar +closure object, where the @code{:dynbind} marker is replaced by the +captured variables (@pxref{Closures}). The @code{lambda} form has one other effect: it tells the Emacs evaluator and byte-compiler that its argument is a function, by using @@ -1164,8 +1174,8 @@ Anonymous Functions @defspec function function-object @cindex function quoting -This special form returns @var{function-object} without evaluating it. -In this, it is similar to @code{quote} (@pxref{Quoting}). But unlike +This special form returns the function value of the @var{function-object}. +In many ways, it is similar to @code{quote} (@pxref{Quoting}). But unlike @code{quote}, it also serves as a note to the Emacs evaluator and byte-compiler that @var{function-object} is intended to be used as a function. Assuming @var{function-object} is a valid lambda @@ -1495,7 +1505,7 @@ Function Cells @group (defun bar (n) (+ n 2)) (symbol-function 'bar) - @result{} (lambda (n) (+ n 2)) + @result{} #f(lambda (n) [t] (+ n 2)) @end group @group (fset 'baz 'bar) @@ -1608,7 +1618,7 @@ Closures @example ;; @r{lexical binding is enabled.} (lambda (x) (* x x)) - @result{} (closure (t) (x) (* x x)) + @result{} #f(lambda (x) [t] (* x x)) @end example @noindent 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 @@ Rearrangement @group (symbol-function 'add-foo) - @result{} (lambda (x) (nconc '(foo) x)) + @result{} #f(lambda (x) [t] (nconc '(foo) x)) @end group @group @@ -1267,7 +1267,7 @@ Rearrangement @group (symbol-function 'add-foo) - @result{} (lambda (x) (nconc '(foo 1 2 3 4) x)) + @result{} #f(lambda (x) [t] (nconc '(foo 1 2 3 4) x)) @end group @end smallexample @end defun 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 @@ Programming Types * Macro Type:: A method of expanding an expression into another expression, more fundamental but less pretty. * Primitive Function Type:: A function written in C, callable from Lisp. -* Byte-Code Type:: A function written in Lisp, then compiled. +* Closure Type:: A function written in Lisp. * Record Type:: Compound objects with programmer-defined types. * Type Descriptors:: Objects holding information about types. * Autoload Type:: A type used for automatically loading seldom-used @@ -1458,18 +1458,24 @@ Primitive Function Type @end group @end example -@node Byte-Code Type -@subsection Byte-Code Function Type +@node Closure Type +@subsection Closure Function Type -@dfn{Byte-code function objects} are produced by byte-compiling Lisp -code (@pxref{Byte Compilation}). Internally, a byte-code function -object is much like a vector; however, the evaluator handles this data -type specially when it appears in a function call. @xref{Byte-Code -Objects}. +@dfn{Closures} are function objects produced when turning a function +definition into a function value. Closures are used both for +byte-compiled Lisp functions as well as for interpreted Lisp functions. +Closures can be produced by byte-compiling Lisp code (@pxref{Byte +Compilation}) or simply by evaluating a lambda expression without +compiling it, resulting in an interpreted function. Internally, +a closure is much like a vector; however, the evaluator +handles this data type specially when it appears in a function call. +@xref{Closure Objects}. The printed representation and read syntax for a byte-code function object is like that for a vector, with an additional @samp{#} before the -opening @samp{[}. +opening @samp{[}. When printed for human consumption, it is printed as +a special kind of list with an additional @samp{#f} before the opening +@samp{(}. @node Record Type @subsection Record Type @@ -2042,10 +2048,7 @@ Type Predicates @xref{Buffer Basics, bufferp}. @item byte-code-function-p -@xref{Byte-Code Type, byte-code-function-p}. - -@item compiled-function-p -@xref{Byte-Code Type, compiled-function-p}. +@xref{Closure Type, byte-code-function-p}. @item case-table-p @xref{Case Tables, case-table-p}. @@ -2056,9 +2059,15 @@ Type Predicates @item char-table-p @xref{Char-Tables, char-table-p}. +@item closurep +@xref{What Is a Function, closurep}. + @item commandp @xref{Interactive Call, commandp}. +@item compiled-function-p +@xref{Closure Type, compiled-function-p}. + @item condition-variable-p @xref{Condition Variables, condition-variable-p}. @@ -2098,6 +2107,9 @@ Type Predicates @item integerp @xref{Predicates on Numbers, integerp}. +@item interpreted-function-p +@xref{What Is a Function, interpreted-function-p}. + @item keymapp @xref{Creating Keymaps, keymapp}. 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 @@ Vector Functions The @code{vconcat} function also allows byte-code function objects as arguments. This is a special feature to make it easy to access the entire -contents of a byte-code function object. @xref{Byte-Code Objects}. +contents of a byte-code function object. @xref{Closure Objects}. For other concatenation functions, see @code{mapconcat} in @ref{Mapping Functions}, @code{concat} in @ref{Creating Strings}, and @code{append} 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 @@ Lexical Binding (let ((x 0)) ; @r{@code{x} is lexically bound.} (setq my-ticker (lambda () (setq x (1+ x))))) - @result{} (closure ((x . 0)) () + @result{} #f(lambda () [(x 0)] (setq x (1+ x))) (funcall my-ticker) diff --git a/etc/NEWS b/etc/NEWS index 78a1307b6a4..eeca290d2e8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1740,6 +1740,23 @@ documentation and examples. * Incompatible Lisp Changes in Emacs 30.1 ++++ +** Evaluating a 'lambda' returns an object of type 'interpreted-function'. +Instead of representing interpreted functions as lists that start with +either 'lambda' or 'closure', Emacs now represents them as objects +of their own 'interpreted-function' type, which is very similar +to 'byte-code-function' objects (the argument list, docstring, and +interactive forms are placed in the same slots). +Lists that start with 'lambda' are now used only for non-evaluated +functions (in other words, for source code), but for backward compatibility +reasons, 'functionp' still recognizes them as functions and you can +still call them as before. +Thus code that attempts to "dig" into the internal structure of an +interpreted function's object with the likes of 'car' or 'cdr' will +no longer work and will need to use 'aref' used instead to extract its +various subparts (when 'interactive-form', 'documentation', and +'help-function-arglist' aren't adequate). + +++ ** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'. Minor modes defined with 'define-globalized-minor-mode', such as 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 @@ byte-compile-inline-expand ;; The byte-code will be really inlined in byte-compile-unfold-bcf. (byte-compile--check-arity-bytecode form fn) `(,fn ,@(cdr form))) - ((or `(lambda . ,_) `(closure . ,_)) + ((pred interpreted-function-p) ;; While byte-compile-unfold-bcf can inline dynbind byte-code into ;; letbind byte-code (or any other combination for that matter), we ;; can only inline dynbind source into dynbind source or lexbind @@ -1870,6 +1870,7 @@ byte-optimize-set charsetp ;; data.c arrayp atom bare-symbol-p bool-vector-p bufferp byte-code-function-p + interpreted-function-p closurep byteorder car-safe cdr-safe char-or-string-p char-table-p condition-variable-p consp eq floatp indirect-function integer-or-marker-p integerp keywordp listp markerp 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 @@ byte-compile-output-as-comment (defun byte-compile--reify-function (fun) "Return an expression which will evaluate to a function value FUN. FUN should be an interpreted closure." - (pcase-let* ((`(closure ,env ,args . ,body) fun) - (`(,preamble . ,body) (macroexp-parse-body body)) - (renv ())) + (let* ((args (aref fun 0)) + (body (aref fun 1)) + (env (aref fun 2)) + (docstring (function-documentation fun)) + (iform (interactive-form fun)) + (preamble `(,@(if docstring (list docstring)) + ,@(if iform (list iform)))) + (renv ())) ;; Turn the function's closed vars (if any) into local let bindings. (dolist (binding env) (cond @@ -2939,11 +2944,11 @@ byte-compile (if (symbolp form) form "provided")) fun) (t - (when (or (symbolp form) (eq (car-safe fun) 'closure)) + (when (or (symbolp form) (interpreted-function-p fun)) ;; `fun' is a function *value*, so try to recover its ;; corresponding source code. - (when (setq lexical-binding (eq (car-safe fun) 'closure)) - (setq fun (byte-compile--reify-function fun))) + (setq lexical-binding (not (null (aref fun 2)))) + (setq fun (byte-compile--reify-function fun)) (setq need-a-value t)) ;; Expand macros. (setq fun (byte-compile-preprocess fun)) @@ -5133,7 +5138,6 @@ byte-compile-file-form-defalias ;; `arglist' is the list of arguments (or t if not recognized). ;; `body' is the body of `lam' (or t if not recognized). ((or `(lambda ,arglist . ,body) - ;; `(closure ,_ ,arglist . ,body) (and `(internal-make-closure ,arglist . ,_) (let body t)) (and (let arglist t) (let body t))) lam)) 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 @@ cconv-fv (delete-dups cconv--dynbindings))))) (cons fvs dyns))))) -(defun cconv-make-interpreted-closure (fun env) +(defun cconv-make-interpreted-closure (args body env docstring iform) "Make a closure for the interpreter. This is intended to be called at runtime by the ELisp interpreter (when the code has not been compiled). @@ -911,22 +911,27 @@ cconv-make-interpreted-closure i.e. a list whose elements can be either plain symbols (which indicate that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE) for the lexical bindings." - (cl-assert (eq (car-safe fun) 'lambda)) + (cl-assert (consp body)) + (cl-assert (listp args)) (let ((lexvars (delq nil (mapcar #'car-safe env)))) - (if (or (null lexvars) - ;; Functions with a `:closure-dont-trim-context' marker - ;; should keep their whole context untrimmed (bug#59213). - (and (eq :closure-dont-trim-context (nth 2 fun)) - ;; Check the function doesn't just return the magic keyword. - (nthcdr 3 fun))) + (if (or + ;; Functions with a `:closure-dont-trim-context' marker + ;; should keep their whole context untrimmed (bug#59213). + (and (eq :closure-dont-trim-context (car body)) + ;; Check the function doesn't just return the magic keyword. + (cdr body) + ;; Drop the magic marker from the closure. + (setq body (cdr body))) + ;; There's no var to capture, so skip the analysis. + (null lexvars)) ;; The lexical environment is empty, or needs to be preserved, ;; so there's no need to look for free variables. - ;; Attempting to replace ,(cdr fun) by a macroexpanded version - ;; causes bootstrap to fail. - `(closure ,env . ,(cdr fun)) + ;; Attempting to replace body by a macroexpanded version + ;; caused bootstrap to fail. + (make-interpreted-closure args body env docstring iform) ;; We could try and cache the result of the macroexpansion and ;; `cconv-fv' analysis. Not sure it's worth the trouble. - (let* ((form `#',fun) + (let* ((form `#'(lambda ,args ,iform . ,body)) (expanded-form (let ((lexical-binding t) ;; Tell macros which dialect is in use. ;; Make the macro aware of any defvar declarations in scope. @@ -935,10 +940,10 @@ cconv-make-interpreted-closure (append env macroexp--dynvars) env))) (macroexpand-all form macroexpand-all-environment))) ;; Since we macroexpanded the body, we may as well use that. - (expanded-fun-cdr + (expanded-fun-body (pcase expanded-form - (`#'(lambda . ,cdr) cdr) - (_ (cdr fun)))) + (`#'(lambda ,_args ,_iform . ,newbody) newbody) + (_ body))) (dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env))) (fvs (cconv-fv expanded-form lexvars dynvars)) @@ -946,7 +951,8 @@ cconv-make-interpreted-closure (cdr fvs)))) ;; Never return a nil env, since nil means to use the dynbind ;; dialect of ELisp. - `(closure ,(or newenv '(t)) . ,expanded-fun-cdr))))) + (make-interpreted-closure args expanded-fun-body (or newenv '(t)) + docstring iform))))) (provide 'cconv) 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 @@ function ) (cl--define-built-in-type compiled-function (function) "Abstract type of functions that have been compiled.") -(cl--define-built-in-type byte-code-function (compiled-function) +(cl--define-built-in-type closure (function) + "Abstract type of functions represented by a vector-like object. +You can access the object's internals with `aref'. +The fields are used as follows: + + 0 [args] Argument list (either a list or an integer) + 1 [code] Either a byte-code string or a list of Lisp forms + 2 [constants] Either vector of constants or a lexical environment + 3 [stackdepth] Maximum amount of stack depth used by the byte-code + 4 [docstring] The documentation, or a reference to it + 5 [iform] The interactive form (if present)") +(cl--define-built-in-type byte-code-function (compiled-function closure) "Type of functions that have been byte-compiled.") (cl--define-built-in-type subr (atom) "Abstract type of functions compiled to machine code.") (cl--define-built-in-type module-function (function) "Type of functions provided via the module API.") -(cl--define-built-in-type interpreted-function (function) +(cl--define-built-in-type interpreted-function (closure) "Type of functions that have not been compiled.") (cl--define-built-in-type special-form (subr) "Type of the core syntactic elements of the Emacs Lisp language.") 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 @@ cl-print-object 'byte-code-function object))))) (princ ")" stream))) +(cl-defmethod cl-print-object ((object interpreted-function) stream) + (unless stream (setq stream standard-output)) + (princ "#f(lambda " stream) + (let ((args (help-function-arglist object 'preserve-names))) + ;; It's tempting to print the arglist from the "usage" info in the + ;; doc (e.g. for `&key` args), but that only makes sense if we + ;; *don't* print the body, since otherwise the body will tend to + ;; refer to args that don't appear in the arglist. + (if args + (prin1 args stream) + (princ "()" stream))) + (let ((env (aref object 2))) + (if (null env) + (princ " :dynbind" stream) + (princ " " stream) + (cl-print-object + (vconcat (mapcar (lambda (x) (if (consp x) (list (car x) (cdr x)) x)) + env)) + stream))) + (let* ((doc (documentation object 'raw))) + (when doc + (princ " " stream) + (prin1 doc stream))) + (let ((inter (interactive-form object))) + (when inter + (princ " " stream) + (cl-print-object inter stream))) + (dolist (exp (aref object 1)) + (princ " " stream) + (cl-print-object exp stream)) + (princ ")" stream)) + ;; This belongs in oclosure.el, of course, but some load-ordering issues make it ;; complicated. (cl-defmethod cl-print-object ((object accessor) stream) 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 @@ comp-known-type-specifiers (buffer-substring (function ((or integer marker) (or integer marker)) string)) (bufferp (function (t) boolean)) + (closurep (function (t) boolean)) (byte-code-function-p (function (t) boolean)) + (interpreted-function-p (function (t) boolean)) (capitalize (function ((or integer string)) (or integer string))) (car (function (list) t)) (car-less-than-car (function (list list) boolean)) 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 @@ disassemble-internal (setq args (help-function-arglist obj)) ;save arg list (setq obj (cdr obj)) ;throw lambda away (setq obj (cdr obj))) - ((byte-code-function-p obj) + ((closurep obj) (setq args (help-function-arglist obj))) (t (error "Compilation failed"))) (if (zerop indent) ; not a nested function @@ -178,7 +178,9 @@ disassemble-internal (t (insert "Uncompiled body: ") (let ((print-escape-newlines t)) - (prin1 (macroexp-progn obj) + (prin1 (macroexp-progn (if (interpreted-function-p obj) + (aref obj 1) + obj)) (current-buffer)))))) (if interactive-p (message ""))) 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 @@ edebug--strip-instrumentation ((pred edebug--symbol-prefixed-p) nil) (_ (when (and skip-next-lambda - (not (memq (car-safe fun) '(closure lambda)))) + (not (interpreted-function-p fun))) (warn "Edebug--strip-instrumentation expected an interpreted function:\n%S" fun)) (unless skip-next-lambda (edebug--unwrap-frame new-frame) 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-indent-defform (put 'condition-case 'lisp-indent-function 2) (put 'handler-case 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) -(put 'closure 'lisp-indent-function 2) (defun indent-sexp (&optional endpos) "Indent each line of the list starting just after point. 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 @@ advice-eval-interactive-spec (defun advice--interactive-form-1 (function) "Like `interactive-form' but preserves the static context if needed." (let ((if (interactive-form function))) - (if (or (null if) (not (eq 'closure (car-safe function)))) + (if (not (and if (interpreted-function-p function))) if (cl-assert (eq 'interactive (car if))) (let ((form (cadr if))) @@ -193,14 +193,14 @@ advice--interactive-form-1 if ;; The interactive is expected to be run in the static context ;; that the function captured. - (let ((ctx (nth 1 function))) + (let ((ctx (aref function 2))) `(interactive ,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form))) ;; If the form jut returns a function, preserve the fact that ;; it just returns a function, which is an info we use in ;; `advice--make-interactive-form'. (if (eq 'lambda (car-safe f)) - `',(eval form ctx) + (eval form ctx) `(eval ',form ',ctx)))))))))) (defun advice--interactive-form (function) 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 @@ oclosure--index-table (setf (cl--find-class 'oclosure) (oclosure--class-make 'oclosure "The root parent of all OClosure types" - nil (list (cl--find-class 'function)) + nil (list (cl--find-class 'closure)) '(oclosure))) (defun oclosure--p (oclosure) (not (not (oclosure-type oclosure)))) @@ -431,75 +431,57 @@ oclosure-lambda (defun oclosure--fix-type (_ignore oclosure) "Helper function to implement `oclosure-lambda' via a macro. -This has 2 uses: -- For interpreted code, this converts the representation of type information - by moving it from the docstring to the environment. -- For compiled code, this is used as a marker which cconv uses to check that - immutable fields are indeed not mutated." - (if (byte-code-function-p oclosure) - ;; Actually, this should never happen since `cconv.el' should have - ;; optimized away the call to this function. - oclosure - ;; For byte-coded functions, we store the type as a symbol in the docstring - ;; slot. For interpreted functions, there's no specific docstring slot - ;; so `Ffunction' turns the symbol into a string. - ;; We thus have convert it back into a symbol (via `intern') and then - ;; stuff it into the environment part of the closure with a special - ;; marker so we can distinguish this entry from actual variables. - (cl-assert (eq 'closure (car-safe oclosure))) - (let ((typename (nth 3 oclosure))) ;; The "docstring". - (cl-assert (stringp typename)) - (push (cons :type (intern typename)) - (cadr oclosure)) - oclosure))) +This is used as a marker which cconv uses to check that +immutable fields are indeed not mutated." + (cl-assert (closurep oclosure)) + ;; This should happen only for interpreted closures since `cconv.el' + ;; should have optimized away the call to this function. + oclosure) (defun oclosure--copy (oclosure mutlist &rest args) + (cl-assert (closurep oclosure)) (if (byte-code-function-p oclosure) (apply #'make-closure oclosure (if (null mutlist) args (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args))) - (cl-assert (eq 'closure (car-safe oclosure)) - nil "oclosure not closure: %S" oclosure) - (cl-assert (eq :type (caar (cadr oclosure)))) - (let ((env (cadr oclosure))) - `(closure - (,(car env) - ,@(named-let loop ((env (cdr env)) (args args)) - (when args - (cons (cons (caar env) (car args)) - (loop (cdr env) (cdr args))))) - ,@(nthcdr (1+ (length args)) env)) - ,@(nthcdr 2 oclosure))))) + (cl-assert (consp (aref oclosure 1))) + (cl-assert (null (aref oclosure 3))) + (cl-assert (symbolp (aref oclosure 4))) + (let ((env (aref oclosure 2))) + (make-interpreted-closure + (aref oclosure 0) + (aref oclosure 1) + (named-let loop ((env env) (args args)) + (if (null args) env + (cons (cons (caar env) (car args)) + (loop (cdr env) (cdr args))))) + (aref oclosure 4) + (if (> (length oclosure) 5) + `(interactive ,(aref oclosure 5))))))) (defun oclosure--get (oclosure index mutable) - (if (byte-code-function-p oclosure) - (let* ((csts (aref oclosure 2)) - (v (aref csts index))) - (if mutable (car v) v)) - (cl-assert (eq 'closure (car-safe oclosure))) - (cl-assert (eq :type (caar (cadr oclosure)))) - (cdr (nth (1+ index) (cadr oclosure))))) + (cl-assert (closurep oclosure)) + (let* ((csts (aref oclosure 2))) + (if (vectorp csts) + (let ((v (aref csts index))) + (if mutable (car v) v)) + (cdr (nth index csts))))) (defun oclosure--set (v oclosure index) - (if (byte-code-function-p oclosure) - (let* ((csts (aref oclosure 2)) - (cell (aref csts index))) - (setcar cell v)) - (cl-assert (eq 'closure (car-safe oclosure))) - (cl-assert (eq :type (caar (cadr oclosure)))) - (setcdr (nth (1+ index) (cadr oclosure)) v))) + (cl-assert (closurep oclosure)) + (let ((csts (aref oclosure 2))) + (if (vectorp csts) + (let ((cell (aref csts index))) + (setcar cell v)) + (setcdr (nth index csts) v)))) (defun oclosure-type (oclosure) - "Return the type of OCLOSURE, or nil if the arg is not a OClosure." - (if (byte-code-function-p oclosure) - (let ((type (and (> (length oclosure) 4) (aref oclosure 4)))) - (if (symbolp type) type)) - (and (eq 'closure (car-safe oclosure)) - (let* ((env (car-safe (cdr oclosure))) - (first-var (car-safe env))) - (and (eq :type (car-safe first-var)) - (cdr first-var)))))) + "Return the type of OCLOSURE, or nil if the arg is not an OClosure." + (and (closurep oclosure) + (> (length oclosure) 4) + (let ((type (aref oclosure 4))) + (if (symbolp type) type)))) (defconst oclosure--accessor-prototype ;; Use `oclosure--lambda' to circumvent a bootstrapping problem: 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 @@ help-function-arglist ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) (cond - ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0)) + ((and (closurep def) (listp (aref def 0))) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) - ((eq (car-safe def) 'closure) (nth 2 def)) ((and (featurep 'native-compile) (subrp def) (listp (subr-native-lambda-list def))) 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 @@ profiler-calltree-build-1 (define-hash-table-test 'profiler-function-equal #'function-equal - (lambda (f) (cond - ((byte-code-function-p f) (aref f 1)) - ((eq (car-safe f) 'closure) (cddr f)) - (t f)))) + (lambda (f) (if (closurep f) (aref f 1) f))) (defun profiler-calltree-build-unified (tree log) ;; Let's try to unify all those partial backtraces into a single 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-documentation (or (stringp doc) (fixnump doc) (fixnump (cdr-safe doc)))))) (pcase function - ((pred byte-code-function-p) + ((pred closurep) (when (> (length function) 4) (let ((doc (aref function 4))) (when (funcall docstring-p doc) doc)))) ((or (pred stringp) (pred vectorp)) "Keyboard macro.") (`(keymap . ,_) "Prefix command (definition is a keymap associating keystrokes with commands).") - ((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body) - `(autoload ,_file . ,body)) + ((or `(lambda ,_args . ,body) `(autoload ,_file . ,body)) (let ((doc (car body))) (when (funcall docstring-p doc) doc))) 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 @@ DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, { Lisp_Object funval = Findirect_function (function, Qt); uintmax_t events = num_input_events; + Lisp_Object env = CLOSUREP (funval) && CONSP (AREF (funval, CLOSURE_CODE)) + ? AREF (funval, CLOSURE_CONSTANTS) : Qnil; /* Compute the arg values using the user's expression. */ - specs = Feval (specs, - CONSP (funval) && EQ (Qclosure, XCAR (funval)) - ? CAR_SAFE (XCDR (funval)) : Qnil); + specs = Feval (specs, env); if (events != num_input_events || !NILP (record_flag)) { /* We should record this command on the command history. 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 @@ DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0, return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp : Qprimitive_function; - case PVEC_CLOSURE: return Qcompiled_function; + case PVEC_CLOSURE: + return CONSP (AREF (object, CLOSURE_CODE)) + ? Qinterpreted_function : Qbyte_code_function; case PVEC_BUFFER: return Qbuffer; case PVEC_CHAR_TABLE: return Qchar_table; case PVEC_BOOL_VECTOR: return Qbool_vector; @@ -518,12 +520,32 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, return Qnil; } +DEFUN ("closurep", Fclosurep, Sclosurep, + 1, 1, 0, + doc: /* Return t if OBJECT is a function of type `closure'. */) + (Lisp_Object object) +{ + if (CLOSUREP (object)) + return Qt; + return Qnil; +} + DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, 1, 1, 0, doc: /* Return t if OBJECT is a byte-compiled function object. */) (Lisp_Object object) { - if (CLOSUREP (object)) + if (CLOSUREP (object) && STRINGP (AREF (object, CLOSURE_CODE))) + return Qt; + return Qnil; +} + +DEFUN ("interpreted-function-p", Finterpreted_function_p, + Sinterpreted_function_p, 1, 1, 0, + doc: /* Return t if OBJECT is a function of type `interpreted-function'. */) + (Lisp_Object object) +{ + if (CLOSUREP (object) && CONSP (AREF (object, CLOSURE_CODE))) return Qt; return Qnil; } @@ -1174,17 +1196,11 @@ DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); - if (EQ (funcar, Qclosure) - || EQ (funcar, Qlambda)) + if (EQ (funcar, Qlambda)) { Lisp_Object form = Fcdr (XCDR (fun)); - if (EQ (funcar, Qclosure)) - form = Fcdr (form); Lisp_Object spec = Fassq (Qinteractive, form); - if (NILP (spec) && VALID_DOCSTRING_P (CAR_SAFE (form))) - /* A "docstring" is a sign that we may have an OClosure. */ - genfun = true; - else if (NILP (Fcdr (Fcdr (spec)))) + if (NILP (Fcdr (Fcdr (spec)))) return spec; else return list2 (Qinteractive, Fcar (Fcdr (spec))); @@ -1257,12 +1273,9 @@ DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0, else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); - if (EQ (funcar, Qclosure) - || EQ (funcar, Qlambda)) + if (EQ (funcar, Qlambda)) { Lisp_Object form = Fcdr (XCDR (fun)); - if (EQ (funcar, Qclosure)) - form = Fcdr (form); return Fcdr (Fcdr (Fassq (Qinteractive, form))); } } @@ -4224,7 +4237,8 @@ #define PUT_ERROR(sym, tail, msg) \ DEFSYM (Qspecial_form, "special-form"); DEFSYM (Qprimitive_function, "primitive-function"); DEFSYM (Qsubr_native_elisp, "subr-native-elisp"); - DEFSYM (Qcompiled_function, "compiled-function"); + DEFSYM (Qbyte_code_function, "byte-code-function"); + DEFSYM (Qinterpreted_function, "interpreted-function"); DEFSYM (Qbuffer, "buffer"); DEFSYM (Qframe, "frame"); DEFSYM (Qvector, "vector"); @@ -4289,6 +4303,8 @@ #define PUT_ERROR(sym, tail, msg) \ defsubr (&Smarkerp); defsubr (&Ssubrp); defsubr (&Sbyte_code_function_p); + defsubr (&Sinterpreted_function_p); + defsubr (&Sclosurep); defsubr (&Smodule_function_p); defsubr (&Schar_or_string_p); defsubr (&Sthreadp); diff --git a/src/eval.c b/src/eval.c index a7d860114cf..6812cbf4835 100644 --- a/src/eval.c +++ b/src/eval.c @@ -510,6 +510,32 @@ DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0, return XCAR (args); } +DEFUN ("make-interpreted-closure", Fmake_interpreted_closure, + Smake_interpreted_closure, 3, 5, 0, + doc: /* Make an interpreted closure. +ARGS should be the list of formal arguments. +BODY should be a non-empty list of forms. +ENV should be a lexical environment, like the second argument of `eval'. +IFORM if non-nil should be of the form (interactive ...). */) + (Lisp_Object args, Lisp_Object body, Lisp_Object env, + Lisp_Object docstring, Lisp_Object iform) +{ + CHECK_CONS (body); /* Make sure it's not confused with byte-code! */ + CHECK_LIST (args); + CHECK_LIST (iform); + Lisp_Object slots[] = { args, body, env, Qnil, docstring, + NILP (Fcdr (iform)) + ? Fcar (iform) + : CALLN (Fvector, XCAR (iform), XCDR (iform)) }; + /* Adjusting the size is indispensable since, as for byte-code objects, + we distinguish interactive functions by the presence or absence of the + iform slot. */ + Lisp_Object val + = Fvector (!NILP (iform) ? 6 : !NILP (docstring) ? 5 : 3, slots); + XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE); + return val; +} + DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, doc: /* Like `quote', but preferred for objects which are functions. In byte compilation, `function' causes its argument to be handled by @@ -525,33 +551,55 @@ DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, if (!NILP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); - if (!NILP (Vinternal_interpreter_environment) - && CONSP (quoted) + if (CONSP (quoted) && EQ (XCAR (quoted), Qlambda)) { /* This is a lambda expression within a lexical environment; return an interpreted closure instead of a simple lambda. */ Lisp_Object cdr = XCDR (quoted); - Lisp_Object tmp = cdr; - if (CONSP (tmp) - && (tmp = XCDR (tmp), CONSP (tmp)) - && (tmp = XCAR (tmp), CONSP (tmp)) - && (EQ (QCdocumentation, XCAR (tmp)))) - { /* Handle the special (:documentation <form>) to build the docstring + Lisp_Object args = Fcar (cdr); + cdr = Fcdr (cdr); + Lisp_Object docstring = Qnil, iform = Qnil; + if (CONSP (cdr)) + { + docstring = XCAR (cdr); + if (STRINGP (docstring)) + { + Lisp_Object tmp = XCDR (cdr); + if (!NILP (tmp)) + cdr = tmp; + else /* It's not a docstring, it's a return value. */ + docstring = Qnil; + } + /* Handle the special (:documentation <form>) to build the docstring dynamically. */ - Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp))); - if (SYMBOLP (docstring) && !NILP (docstring)) - /* Hack for OClosures: Allow the docstring to be a symbol - * (the OClosure's type). */ - docstring = Fsymbol_name (docstring); - CHECK_STRING (docstring); - cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr)))); - } - if (NILP (Vinternal_make_interpreted_closure_function)) - return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, cdr)); + else if (CONSP (docstring) + && EQ (QCdocumentation, XCAR (docstring)) + && (docstring = eval_sub (Fcar (XCDR (docstring))), + true)) + cdr = XCDR (cdr); + else + docstring = Qnil; /* Not a docstring after all. */ + } + if (CONSP (cdr)) + { + iform = XCAR (cdr); + if (CONSP (iform) + && EQ (Qinteractive, XCAR (iform))) + cdr = XCDR (cdr); + else + iform = Qnil; /* Not an interactive-form after all. */ + } + if (NILP (cdr)) + cdr = Fcons (Qnil, Qnil); /* Make sure the body is never empty! */ + + if (NILP (Vinternal_interpreter_environment) + || NILP (Vinternal_make_interpreted_closure_function)) + return Fmake_interpreted_closure + (args, cdr, Vinternal_interpreter_environment, docstring, iform); else - return call2 (Vinternal_make_interpreted_closure_function, - Fcons (Qlambda, cdr), - Vinternal_interpreter_environment); + return call5 (Vinternal_make_interpreted_closure_function, + args, cdr, Vinternal_interpreter_environment, + docstring, iform); } else /* Simply quote the argument. */ @@ -2193,15 +2241,12 @@ DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0, else { Lisp_Object body = CDR_SAFE (XCDR (fun)); - if (EQ (funcar, Qclosure)) - body = CDR_SAFE (body); - else if (!EQ (funcar, Qlambda)) + if (!EQ (funcar, Qlambda)) return Qnil; if (!NILP (Fassq (Qinteractive, body))) return Qt; - else if (VALID_DOCSTRING_P (CAR_SAFE (body))) - /* A "docstring" is a sign that we may have an OClosure. */ - genfun = true; + else + return Qnil; } } @@ -2611,8 +2656,7 @@ eval_sub (Lisp_Object form) exp = unbind_to (count1, exp); val = eval_sub (exp); } - else if (EQ (funcar, Qlambda) - || EQ (funcar, Qclosure)) + else if (EQ (funcar, Qlambda)) return apply_lambda (fun, original_args, count); else xsignal1 (Qinvalid_function, original_fun); @@ -2950,7 +2994,7 @@ FUNCTIONP (Lisp_Object object) else if (CONSP (object)) { Lisp_Object car = XCAR (object); - return EQ (car, Qlambda) || EQ (car, Qclosure); + return EQ (car, Qlambda); } else return false; @@ -2980,8 +3024,7 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) Lisp_Object funcar = XCAR (fun); if (!SYMBOLP (funcar)) xsignal1 (Qinvalid_function, original_fun); - if (EQ (funcar, Qlambda) - || EQ (funcar, Qclosure)) + if (EQ (funcar, Qlambda)) return funcall_lambda (fun, numargs, args); else if (EQ (funcar, Qautoload)) { @@ -3165,16 +3208,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) if (CONSP (fun)) { - if (EQ (XCAR (fun), Qclosure)) - { - Lisp_Object cdr = XCDR (fun); /* Drop `closure'. */ - if (! CONSP (cdr)) - xsignal1 (Qinvalid_function, fun); - fun = cdr; - lexenv = XCAR (fun); - } - else - lexenv = Qnil; + lexenv = Qnil; syms_left = XCDR (fun); if (CONSP (syms_left)) syms_left = XCAR (syms_left); @@ -3189,10 +3223,12 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) engine directly. */ if (FIXNUMP (syms_left)) return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector); - /* Otherwise the bytecode object uses dynamic binding and the - ARGLIST slot contains a standard formal argument list whose - variables are bound dynamically below. */ - lexenv = Qnil; + /* Otherwise the closure either is interpreted + or uses dynamic binding and the ARGLIST slot contains a standard + formal argument list whose variables are bound dynamically below. */ + lexenv = CONSP (AREF (fun, CLOSURE_CODE)) + ? AREF (fun, CLOSURE_CONSTANTS) + : Qnil; } #ifdef HAVE_MODULES else if (MODULE_FUNCTIONP (fun)) @@ -3280,7 +3316,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) val = XSUBR (fun)->function.a0 (); } else - val = exec_byte_code (fun, 0, 0, NULL); + { + eassert (CLOSUREP (fun)); + val = CONSP (AREF (fun, CLOSURE_CODE)) + /* Interpreted function. */ + ? Fprogn (AREF (fun, CLOSURE_CODE)) + /* Dynbound bytecode. */ + : exec_byte_code (fun, 0, 0, NULL); + } return unbind_to (count, val); } @@ -3330,8 +3373,7 @@ DEFUN ("func-arity", Ffunc_arity, Sfunc_arity, 1, 1, 0, funcar = XCAR (function); if (!SYMBOLP (funcar)) xsignal1 (Qinvalid_function, original); - if (EQ (funcar, Qlambda) - || EQ (funcar, Qclosure)) + if (EQ (funcar, Qlambda)) result = lambda_arity (function); else if (EQ (funcar, Qautoload)) { @@ -3352,11 +3394,6 @@ lambda_arity (Lisp_Object fun) if (CONSP (fun)) { - if (EQ (XCAR (fun), Qclosure)) - { - fun = XCDR (fun); /* Drop `closure'. */ - CHECK_CONS (fun); - } syms_left = XCDR (fun); if (CONSP (syms_left)) syms_left = XCAR (syms_left); @@ -4265,7 +4302,6 @@ syms_of_eval (void) DEFSYM (Qcommandp, "commandp"); DEFSYM (Qand_rest, "&rest"); DEFSYM (Qand_optional, "&optional"); - DEFSYM (Qclosure, "closure"); DEFSYM (QCdocumentation, ":documentation"); DEFSYM (Qdebug, "debug"); DEFSYM (Qdebug_early, "debug-early"); @@ -4423,6 +4459,7 @@ syms_of_eval (void) defsubr (&Ssetq); defsubr (&Squote); defsubr (&Sfunction); + defsubr (&Smake_interpreted_closure); defsubr (&Sdefault_toplevel_value); defsubr (&Sset_default_toplevel_value); 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) } } - if (!(size >= CLOSURE_STACK_DEPTH + 1 && size <= CLOSURE_INTERACTIVE + 1 + if (!(size >= CLOSURE_STACK_DEPTH && size <= CLOSURE_INTERACTIVE + 1 && (FIXNUMP (vec[CLOSURE_ARGLIST]) || CONSP (vec[CLOSURE_ARGLIST]) || NILP (vec[CLOSURE_ARGLIST])) - && STRINGP (vec[CLOSURE_CODE]) - && VECTORP (vec[CLOSURE_CONSTANTS]) - && FIXNATP (vec[CLOSURE_STACK_DEPTH]))) + && ((STRINGP (vec[CLOSURE_CODE]) /* Byte-code function. */ + && VECTORP (vec[CLOSURE_CONSTANTS]) + && size > CLOSURE_STACK_DEPTH + && (FIXNATP (vec[CLOSURE_STACK_DEPTH]))) + || (CONSP (vec[CLOSURE_CODE]) /* Interpreted function. */ + && (CONSP (vec[CLOSURE_CONSTANTS]) + || NILP (vec[CLOSURE_CONSTANTS])))))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRING_MULTIBYTE (vec[CLOSURE_CODE])) - /* BYTESTR must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and - now such a byte-code string is loaded as multibyte with - raw 8-bit characters converted to multibyte form. - Convert them back to the original unibyte form. */ - vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]); - - /* Bytecode must be immovable. */ - pin_string (vec[CLOSURE_CODE]); + if (STRINGP (vec[CLOSURE_CODE])) + { + if (STRING_MULTIBYTE (vec[CLOSURE_CODE])) + /* BYTESTR must have been produced by Emacs 20.2 or earlier + because it produced a raw 8-bit string for byte-code and + now such a byte-code string is loaded as multibyte with + raw 8-bit characters converted to multibyte form. + Convert them back to the original unibyte form. */ + vec[CLOSURE_CODE] = Fstring_as_unibyte (vec[CLOSURE_CODE]); + + /* Bytecode must be immovable. */ + pin_string (vec[CLOSURE_CODE]); + } XSETPVECTYPE (XVECTOR (obj), PVEC_CLOSURE); 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) { Lisp_Object f = trace[i]; EMACS_UINT hash1 - = (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE)) - : (CONSP (f) && CONSP (XCDR (f)) && BASE_EQ (Qclosure, XCAR (f))) - ? XHASH (XCDR (XCDR (f))) : XHASH (f)); + = (CLOSUREP (f) ? XHASH (AREF (f, CLOSURE_CODE)) : XHASH (f)); hash = sxhash_combine (hash, hash1); } return hash; @@ -677,10 +675,6 @@ DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0, res = true; else if (CLOSUREP (f1) && CLOSUREP (f2)) res = EQ (AREF (f1, CLOSURE_CODE), AREF (f2, CLOSURE_CODE)); - else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2)) - && EQ (Qclosure, XCAR (f1)) - && EQ (Qclosure, XCAR (f2))) - res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2))); else res = false; return res ? Qt : Qnil; 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 @@ vk-f1 (defconst vk-val3 (eval-when-compile (vk-f3 0))) -(defconst vk-f4 '(lambda (x) - (defvar vk-v4) - (let ((vk-v4 31) - (y 32)) - (ignore vk-v4 x y) - (list - (vk-variable-kind vk-a) ; dyn - (vk-variable-kind vk-b) ; dyn - (vk-variable-kind vk-v4) ; dyn - (vk-variable-kind x) ; dyn - (vk-variable-kind y))))) ; dyn - -(defconst vk-f5 '(closure (t) (x) - (defvar vk-v5) - (let ((vk-v5 41) - (y 42)) - (ignore vk-v5 x y) - (list - (vk-variable-kind vk-a) ; dyn - (vk-variable-kind vk-b) ; dyn - (vk-variable-kind vk-v5) ; dyn - (vk-variable-kind x) ; lex - (vk-variable-kind y))))) ; lex +(defconst vk-f4 (eval '(lambda (x) + (defvar vk-v4) + (let ((vk-v4 31) + (y 32)) + (ignore vk-v4 x y) + (list + (vk-variable-kind vk-a) ; dyn + (vk-variable-kind vk-b) ; dyn + (vk-variable-kind vk-v4) ; dyn + (vk-variable-kind x) ; dyn + (vk-variable-kind y)))) ; dyn + nil)) + +(defconst vk-f5 (eval '(lambda (x) + (defvar vk-v5) + (let ((vk-v5 41) + (y 42)) + (ignore vk-v5 x y) + (list + (vk-variable-kind vk-a) ; dyn + (vk-variable-kind vk-b) ; dyn + (vk-variable-kind vk-v5) ; dyn + (vk-variable-kind x) ; lex + (vk-variable-kind y)))) ; lex + t)) (defun vk-f6 () (eval '(progn 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 @@ erc-d--render-entries (should (equal (funcall it) "foo3foo"))) (ert-info ("Exits clean") - (when (listp (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled - (should (eq 'closure (car (alist-get 'f (erc-d-dialog-vars dialog)))))) + (when (interpreted-function-p + (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled + (should (aref (alist-get 'f (erc-d-dialog-vars dialog)) 2))) (should-not (funcall it)) (should (equal (erc-d-dialog-vars dialog) `((:a . 1) 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 @@ help-fns-test-lisp-macro (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defun () - (let ((regexp (if (featurep 'native-compile) - "a subr-native-elisp in .+subr\\.el" - "a compiled-function in .+subr\\.el")) + (let ((regexp "a \$[^ ]+\$ in .+subr\\.el") (result (help-fns-tests--describe-function 'last))) - (should (string-match regexp result)))) + (should (string-match regexp result)) + (should (member (match-string 1 result) + '("subr-native-elisp" "byte-code-function"))))) (ert-deftest help-fns-test-lisp-defsubst () - (let ((regexp "a compiled-function in .+subr\\.el") + (let ((regexp "a byte-code-function in .+subr\\.el") (result (help-fns-tests--describe-function 'posn-window))) (should (string-match regexp result)))) -- 2.43.0

This bug report was last modified 1 year and 22 days ago.

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.

GNU bug report logs - #70368 [PATCH] Use a dedicated type to represent interpreted-function values

GNU bug report logs - #70368
[PATCH] Use a dedicated type to represent interpreted-function values