[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#70368: [PATCH] Use a dedicated type to represent interpreted-functio
|
From: |
Stefan Monnier |
|
Subject: |
bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values |
|
Date: |
Thu, 18 Apr 2024 12:36:36 -0400 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) |
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@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@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@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
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Stefan Monnier, 2024/04/13
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Eli Zaretskii, 2024/04/14
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Stefan Monnier, 2024/04/14
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Eli Zaretskii, 2024/04/14
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Stefan Monnier, 2024/04/14
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Eli Zaretskii, 2024/04/15
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Stefan Monnier, 2024/04/15
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Eli Zaretskii, 2024/04/15
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values,
Stefan Monnier <=
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Eli Zaretskii, 2024/04/18
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Stefan Monnier, 2024/04/28
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Michael Heerdegen, 2024/04/29
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Stefan Monnier, 2024/04/29
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Michael Heerdegen, 2024/04/29
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Stefan Monnier, 2024/04/29
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Michael Heerdegen, 2024/04/29
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Michael Heerdegen, 2024/04/30
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Stefan Monnier, 2024/04/30
- bug#70368: [PATCH] Use a dedicated type to represent interpreted-function values, Michael Heerdegen, 2024/04/30