* Re: Recognizing declares in lambdas - declarations embedded in functions
2024-07-30 21:29 Recognizing declares in lambdas Thuna
@ 2024-08-01 23:25 ` Thuna
0 siblings, 0 replies; 2+ messages in thread
From: Thuna @ 2024-08-01 23:25 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 4111 bytes --]
> One possibility which I am thinking of would be to add another slot to
> closures which holds these declare forms and to make function-get and
> function-put refer to these slots instead, and while a lot of
> declarations would work out of the box with this setup, stuff like gv's
> declarations will not.
And so I have done. I've attached a patch which can be used as a basis
but does not currently work because of problems I'll address at the end.
The commit message comprehensively explains what I did but it's better
that it's written here too: I have added a `declarations' slot to
Lisp_Subr and closures. Lisp_Subr's slot goes right before the docs and
closure's slot goes where stack depth was, pushing the slots for it, the
docstring, and the interactive form up by one[1].
I have changed DEFUN to have the resulting subr have `lisp_h_Qnil' as
declarations, following what it did for command modes.
I have added an optional DECLS argument to `make-interpreted-closure',
which sets the declarations of the resulting closure as it. `function'
also doesn't prepend the `declarations' form to the body - which was
always a placeholder solution - but instead passes it to `make-interpreted-closure'
(and also to `internal-make-interpreted-closure-function'[2]).
The functions `declarations' and `set-declarations' (names negotiable)
access and set the declarations of functions. The functions these
current cover are subrs, closures, autoloads, unevaluated lambdas, and
macros. The functions `function-get' and `function-put' also just use
these functions now.
I was able to build up to temacs, and managed to load a non-trivial
chunk of lisp before getting crashes. I fixed some earlier problems
with it not building at all, but I am now stuck at a specific
pain-point: because `function-get' and `function-put' work on the
underlying functions themselves instead of the symbols, if they are
called on a not-yet-loaded function they error[3]. This is *usually*
not a problem - you can just move them below the function definition -
but in `defsubst' the speed is being set during compilation where the
options are to switch to using `get' and `put' or to define the function
during compilation as well like `cl-defsubst' does but this is where my
problem lies:
What should be done if the function isn't yet loaded but will be? Sure,
solving the specific situation for defsubst should be relatively easy,
but that's just working around the actual root of the problem. There
might be situations where you could genuinely want the function
properties to be set before the function is loaded - and indeed, this
situation with defsubst is one of them - but you need to determine
whether a function is not defined or defined but deferred, and then you
need to "merge" the properties you have set into the function after it
is loaded, and which do you prioritize, the ones that the loading of the
function set or ones that you set before the function was loaded, and so
on.
This is a very wide-reaching change, and while I can help with patches
like these to lift some of the workload I can neither figure out all the
places that will be effected nor determine a satisfactory solution; I
barely know how the internals work. In this effort some help - or a
proper rejection - would be very appreciated.
[1] All closures need to have a declarations slot, so I found which
slots were guaranteed to exist and appended it at the end.
[2] This means that functions which are possible candidates for
`internal-make-interpreted-closure-function' must now accept a sixth
argument, I have not yet looked into this.
[3] While this is a backwards incompatible change, mixing `{put,get}'
with `function-{get,put}' is already not a good idea. The one thing
this messes up is overriding an alias' declarations; since the thing
that is being checked is the properties of `indirect-function',
`declarations' is exactly identical no matter how deep the underlying
function is. I think that this is probably fine, and IMO it is
definitely conceptually sound, but I am not sure if it is ok like this
or not.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-a-declarations-slot-to-functions.patch --]
[-- Type: text/x-patch, Size: 12651 bytes --]
From 41a89029d54dc3ac23cc317450e809736b9461f1 Mon Sep 17 00:00:00 2001
From: Thuna <thuna.cing@gmail.com>
Date: Fri, 2 Aug 2024 00:28:45 +0200
Subject: [PATCH] Add a declarations slot to functions
* src/lisp.h (Lisp_Subr): Add a `declarations' slot.
(Lisp_Closure): Add the slot name `CLOSURE_DECLARATION' for the fourth
slot, move the other slots up by one.
(DEFUN): Put `nil' into the `declarations' slot.
* src/eval.c (make-interpreted-closure): Add an optional argument
`decls' which sets the declarations slot of the closure created. Adjust
the slots to which objects go.
(function): Pass the parsed declarations to `make-interpreted-closure'
and `internal-make-interpreted-closure-function'.
* src/data.c (declarations set-declarations): Define functions which
access the declarations slot of functions.
(lambda_set_declarations): Define function which sets the declarations
of an unevaluated lambda.
* lisp/subr.el (function-get): Refer to `declarations'. Make the
AUTOLOAD argument obsolete.
* lisp/emacs-lisp/byte-run.el (function-put): Use `declarations' and
`set-declarations'.
---
lisp/emacs-lisp/byte-run.el | 13 ++--
lisp/subr.el | 24 ++------
src/data.c | 116 ++++++++++++++++++++++++++++++++++++
src/eval.c | 26 ++++----
src/lisp.h | 11 ++--
5 files changed, 148 insertions(+), 42 deletions(-)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index f1486f70634..e2fa9839b53 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -105,12 +105,11 @@ 'function-put
;; hook into `put' to remap old properties to new ones. But for now, there's
;; no such remapping, so we just call `put'.
#'(lambda (function prop value)
- "Set FUNCTION's property PROP to VALUE.
-The namespace for PROP is shared with symbols.
-So far, FUNCTION can only be a symbol, not a lambda expression."
- (put (bare-symbol function) prop value)))
-(function-put 'defmacro 'doc-string-elt 3)
-(function-put 'defmacro 'lisp-indent-function 2)
+ "Set FUNCTION's property PROP to VALUE."
+ (let* ((declarations (declarations function))
+ (cons (assq prop declarations)))
+ (if cons (setcdr cons value)
+ (set-declarations function (cons (cons prop value) declarations))))))
;; We define macro-declaration-alist here because it is needed to
;; handle declarations in macro definitions and this is the first file
@@ -412,6 +411,8 @@ 'defmacro
(if declarations
(cons 'prog1 (cons def (car declarations)))
def))))))
+(function-put 'defmacro 'doc-string-elt 3)
+(function-put 'defmacro 'lisp-indent-function 2)
;; Now that we defined defmacro we can use it!
(defmacro defun (name arglist &rest body)
diff --git a/lisp/subr.el b/lisp/subr.el
index cf4b7db2e77..c61b93a3e13 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4472,25 +4472,13 @@ sha1
(declare (side-effect-free t))
(secure-hash 'sha1 object start end binary))
-(defun function-get (f prop &optional autoload)
+(defun function-get (f prop &optional _)
"Return the value of property PROP of function F.
-If AUTOLOAD is non-nil and F is autoloaded, try to load it
-in the hope that it will set PROP. If AUTOLOAD is `macro', do it only
-if it's an autoloaded macro."
- (declare (important-return-value t))
- (let ((val nil))
- (while (and (symbolp f)
- (null (setq val (get f prop)))
- (fboundp f))
- (let ((fundef (symbol-function f)))
- (if (and autoload (autoloadp fundef)
- (not (equal fundef
- (autoload-do-load fundef f
- (if (eq autoload 'macro)
- 'macro)))))
- nil ;Re-try `get' on the same `f'.
- (setq f fundef))))
- val))
+This function will attempt to load F if it is autoloaded."
+ (declare (important-return-value t)
+ (advertised-calling-convention (f prop) "31.0"))
+ (cdr (assq prop (declarations f))))
+
\f
;;;; Support for yanking and text properties.
;; Why here in subr.el rather than in simple.el? --Stef
diff --git a/src/data.c b/src/data.c
index d947d200870..7f928abe4b5 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1026,6 +1026,120 @@ DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
return newplist;
}
+DEFUN ("declarations", Fdeclarations, Sdeclarations, 1, 1, 0,
+ doc: /* Return the declarations of FUNCTION.
+This is equivalent to SPECS as passed to `declare'.
+
+If FUNCTION is a symbol, then the indirection is resolved first via
+`indirect-function' and only then are the declarations looked for.
+usage: (declarations FUNCTION) */)
+ (Lisp_Object fun)
+{
+ Lisp_Object original_fun = fun;
+
+ fun = indirect_function (fun);
+ if (NILP (fun))
+ xsignal1 (Qvoid_function, original_fun);
+
+ if (SUBRP (fun))
+ return XSUBR (fun)->declarations;
+ else if (CLOSUREP (fun))
+ return AREF (fun, CLOSURE_DECLARATION);
+ /* TODO: Modules */
+ else if (AUTOLOADP (fun))
+ return Fdeclarations (Fautoload_do_load (fun, original_fun, Qnil));
+ else if (CONSP (fun))
+ {
+ Lisp_Object funcar = XCAR (fun);
+ if (EQ (funcar, Qlambda))
+ return Fcdr (Fassq (Qdeclare, Fcdr (XCDR (fun))));
+ else if (EQ (funcar, Qmacro))
+ return Fdeclarations (XCDR (fun));
+ else
+ xsignal (Qinvalid_function, original_fun);
+ }
+ /* Maybe TODO: oclosures */
+ else
+ xsignal (Qinvalid_function, original_fun);
+}
+
+Lisp_Object
+lambda_set_declerations (Lisp_Object lambda, Lisp_Object decls)
+{
+ Lisp_Object pre_decl = Fcdr (lambda);
+
+ if (!CONSP (pre_decl) || !CONSP (XCDR (pre_decl)))
+ xsignal1 (Qinvalid_function, lambda);
+
+ Lisp_Object maybe_docstring = XCAR (XCDR (pre_decl));
+ if (STRINGP (maybe_docstring)
+ || (CONSP (maybe_docstring)
+ && EQ (QCdocumentation, XCAR (maybe_docstring))))
+ pre_decl = XCDR (pre_decl);
+
+ if (!CONSP (XCDR (pre_decl)))
+ xsignal1 (Qinvalid_function, lambda);
+
+ Lisp_Object maybe_declare = XCAR (XCDR (pre_decl));
+ if (CONSP (maybe_declare) && EQ (Qdeclare, XCAR (maybe_declare)))
+ XSETCDR (maybe_declare, decls);
+ else
+ XSETCDR (pre_decl, Fcons (Fcons (Qdeclare, decls), XCDR (pre_decl)));
+
+ return decls;
+}
+
+DEFUN ("set-declarations", Fset_declarations, Sset_declarations, 2, 2, 0,
+ doc: /* Set FUNCTION's declarations to DECLS.
+
+DECLS must be an alist.
+
+If FUNCTION is a symbol, then the indirection is resolved first via
+`indirect-function' and only then are the declarations looked for.
+usage: (set-declarations FUNCTION DECLS)*/)
+ (Lisp_Object fun, Lisp_Object decls)
+{
+ Lisp_Object original_fun = fun;
+
+ fun = indirect_function (fun);
+ if (NILP (fun))
+ xsignal1 (Qvoid_function, original_fun);
+
+ if (NILP (Flistp (decls)))
+ xsignal2 (Qwrong_type_argument, Qalist, decls);
+
+ Lisp_Object tem = decls;
+ FOR_EACH_TAIL (tem)
+ if (!CONSP (tem))
+ xsignal2 (Qwrong_type_argument, Qalist, decls);
+ /* Given a proper alist the final tail must be a nil. */
+ if (!NILP (tem))
+ xsignal2 (Qwrong_type_argument, Qalist, decls);
+
+ if (SUBRP (fun))
+ return XSUBR (fun)->declarations = decls;
+ else if (CLOSUREP (fun))
+ {
+ ASET (fun, CLOSURE_DECLARATION, decls);
+ return decls;
+ }
+ /* TODO: Modules */
+ else if (AUTOLOADP (fun))
+ return Fset_declarations (Fautoload_do_load (fun, original_fun, Qnil), decls);
+ else if (CONSP (fun))
+ {
+ Lisp_Object funcar = XCAR (fun);
+ if (EQ (funcar, Qlambda))
+ return lambda_set_declerations (fun, decls);
+ else if (EQ (funcar, Qmacro))
+ return Fset_declarations (XCDR (fun), decls);
+ else
+ xsignal1 (Qinvalid_function, original_fun);
+ }
+ else
+ xsignal1 (Qinvalid_function, original_fun);
+}
+
DEFUN ("subr-arity", Fsubr_arity, Ssubr_arity, 1, 1, 0,
doc: /* Return minimum and maximum number of args allowed for SUBR.
SUBR must be a built-in function.
@@ -4277,6 +4391,8 @@ #define PUT_ERROR(sym, tail, msg) \
defsubr (&Sfset);
defsubr (&Sdefalias);
defsubr (&Ssetplist);
+ defsubr (&Sdeclarations);
+ defsubr (&Sset_declarations);
defsubr (&Ssymbol_value);
defsubr (&Sset);
defsubr (&Sdefault_boundp);
diff --git a/src/eval.c b/src/eval.c
index a62f91c5ec0..1b55866e542 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -535,20 +535,21 @@ DEFUN ("declare", Fdeclare, Sdeclare, 0, UNEVALLED, 0,
}
DEFUN ("make-interpreted-closure", Fmake_interpreted_closure,
- Smake_interpreted_closure, 3, 5, 0,
+ Smake_interpreted_closure, 3, 6, 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)
+ Lisp_Object docstring, Lisp_Object iform, Lisp_Object decls)
{
- Lisp_Object ifcdr, value, slots[6];
+ Lisp_Object ifcdr, value, slots[7];
CHECK_CONS (body); /* Make sure it's not confused with byte-code! */
CHECK_LIST (args);
CHECK_LIST (iform);
+ CHECK_LIST (decls);
ifcdr = CDR (iform);
if (NILP (CDR (ifcdr)))
value = CAR (ifcdr);
@@ -557,14 +558,15 @@ DEFUN ("make-interpreted-closure", Fmake_interpreted_closure,
slots[0] = args;
slots[1] = body;
slots[2] = env;
- slots[3] = Qnil;
- slots[4] = docstring;
- slots[5] = value;
+ slots[3] = decls;
+ slots[4] = Qnil;
+ slots[5] = docstring;
+ slots[6] = value;
/* 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);
+ = Fvector (!NILP (iform) ? 7 : !NILP (docstring) ? 6 : 4, slots);
XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE);
return val;
}
@@ -634,21 +636,17 @@ DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
else
iform = Qnil; /* Not an interactive-form after all. */
}
- /* FIXME: Temporary patch since we're not handling declare forms
- in lambdas yet. */
- if (!NILP (decls)) /* FIXME: What about an empty declare? */
- cdr = Fcons (Fcons (Qdeclare, decls), cdr);
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);
+ (args, cdr, Vinternal_interpreter_environment, docstring, iform, decls);
else
- return call5 (Vinternal_make_interpreted_closure_function,
+ return call6 (Vinternal_make_interpreted_closure_function,
args, cdr, Vinternal_interpreter_environment,
- docstring, iform);
+ docstring, iform, decls);
}
else
/* Simply quote the argument. */
diff --git a/src/lisp.h b/src/lisp.h
index 8ac65ca429c..f8369d542ff 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2227,6 +2227,7 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
Lisp_Object native;
} intspec;
Lisp_Object command_modes;
+ Lisp_Object declarations;
EMACS_INT doc;
#ifdef HAVE_NATIVE_COMP
Lisp_Object native_comp_u;
@@ -3254,9 +3255,10 @@ #define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
CLOSURE_ARGLIST = 0,
CLOSURE_CODE = 1,
CLOSURE_CONSTANTS = 2,
- CLOSURE_STACK_DEPTH = 3,
- CLOSURE_DOC_STRING = 4,
- CLOSURE_INTERACTIVE = 5
+ CLOSURE_DECLARATION = 3,
+ CLOSURE_STACK_DEPTH = 4,
+ CLOSURE_DOC_STRING = 5,
+ CLOSURE_INTERACTIVE = 6
};
/* Flag bits in a character. These also get used in termhooks.h.
@@ -3485,7 +3487,8 @@ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
static union Aligned_Lisp_Subr sname = \
{{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
{ .a ## maxargs = fnname }, \
- minargs, maxargs, lname, {intspec}, lisp_h_Qnil}}; \
+ minargs, maxargs, lname, {intspec}, \
+ lisp_h_Qnil, lisp_h_Qnil}}; \
Lisp_Object fnname
/* defsubr (Sname);
--
2.44.2
^ permalink raw reply related [flat|nested] 2+ messages in thread