From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Thuna Newsgroups: gmane.emacs.devel Subject: Re: Recognizing declares in lambdas - declarations embedded in functions Date: Fri, 02 Aug 2024 01:25:40 +0200 Message-ID: <87ed7725cb.fsf@gmail.com> References: <87ikwm1sc0.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="9000"; mail-complaints-to="usenet@ciao.gmane.io" To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Fri Aug 02 07:35:06 2024 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1sZkwT-0002HA-NG for ged-emacs-devel@m.gmane-mx.org; Fri, 02 Aug 2024 07:35:05 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sZkve-0002Ij-NV; Fri, 02 Aug 2024 01:34:14 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sZfB7-0004wM-8z for emacs-devel@gnu.org; Thu, 01 Aug 2024 19:25:49 -0400 Original-Received: from mail-wr1-x435.google.com ([2a00:1450:4864:20::435]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sZfB4-0004UW-K0 for emacs-devel@gnu.org; Thu, 01 Aug 2024 19:25:49 -0400 Original-Received: by mail-wr1-x435.google.com with SMTP id ffacd0b85a97d-369c609d0c7so5083565f8f.3 for ; Thu, 01 Aug 2024 16:25:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1722554743; x=1723159543; darn=gnu.org; h=mime-version:message-id:date:references:in-reply-to:subject:to:from :from:to:cc:subject:date:message-id:reply-to; bh=/oNOy06OquIK2J0XYE98DY0mtDPIresqwCXmbocvD6s=; b=HvWNs5yJA7mD7XJzF/TlkJnIWdPsIVevhcCgLmHKXVDHHXZfORS4/kcRZAfm6rEevp u0mHBSsB1o3NSUYJIa8VAz2xFANosm96SXvnkjpr5XMCJYh8+283W6EaFuKg8cXKh3PS /mYgT0PQ2WA8t2PCpVpDc2/559Vbz6t+Ix4F+9gilvKn9UzLRqYKZJCIRzgPZJ06negm 1OdnQqEb/dFfK3gMYYkoEMXWBrH/YsLfrVy9VSmvbP+ymcUFeZhx3nCS85LEnKGqX0Ru zHAnYvS8IJnUxth1EyuFquE9Q9hVhe7VvuwYxH//3XNUWB2geldKpfmP5FYJ5pcZyUeA tvfg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1722554743; x=1723159543; h=mime-version:message-id:date:references:in-reply-to:subject:to:from :x-gm-message-state:from:to:cc:subject:date:message-id:reply-to; bh=/oNOy06OquIK2J0XYE98DY0mtDPIresqwCXmbocvD6s=; b=KkwZR1r2+GOXe7j+PnZ5flWjp+tLAYnhS7j28wKGyOswd5/S7Ph1uby+1t0eguUWB5 kn7Tj6ofAU9OkobuhhVoe5i/6Ouz2esPkdaO/0P0zihMcDeKLm52TcL1rHNBENxqTd6I X1Wb18ytEAzpUEAWx5Z7xe+3DgeRkoVdH6H9ZWOby8l1grG84TmhKXgxazu7XGxQy1DJ NjJXcEE9A8FtxZtnxIdTwoFI7qLdZdYJwWiL7IZlAkaqpU3cZluZ9AG5M3j7WqzDqkFp eS2aWg3mE6ITpNl4O96/RouFZ9wrM2LO9WGdbM1Ruh9y8LAftEECvaCJumhUGNxclcRe 51Tw== X-Gm-Message-State: AOJu0YzsYYwQM3OP+KxtV3XmhY2lopqXRn81iLZGqcVudRM1DCbOV2Z4 pE6KisICiJlJcdyQSOdtVeRmUpAYxqrmwtFzNhynsf07c/8XGY/TL2hb1Q== X-Google-Smtp-Source: AGHT+IFOD9GRE83pcWRQqJXD6BPzQW5/ABfetXnKkltsfkbFdZt3a8WMqN8OyD8RJNow2VSqJ3hdbw== X-Received: by 2002:a05:6000:b92:b0:368:7ad8:531f with SMTP id ffacd0b85a97d-36bbc1a5174mr934402f8f.42.1722554742920; Thu, 01 Aug 2024 16:25:42 -0700 (PDT) Original-Received: from thuna-lis3 ([85.106.105.81]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36bbd028842sm593814f8f.61.2024.08.01.16.25.41 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 01 Aug 2024 16:25:42 -0700 (PDT) In-Reply-To: <87ikwm1sc0.fsf@gmail.com> Received-SPF: pass client-ip=2a00:1450:4864:20::435; envelope-from=thuna.cing@gmail.com; helo=mail-wr1-x435.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Fri, 02 Aug 2024 01:34:12 -0400 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:322278 Archived-At: --=-=-= Content-Type: text/plain > 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Add-a-declarations-slot-to-functions.patch >From 41a89029d54dc3ac23cc317450e809736b9461f1 Mon Sep 17 00:00:00 2001 From: Thuna 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)))) + ;;;; 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 --=-=-=--