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: Unify make-closure, make-interpreted-closure, and make-byte-code Date: Mon, 18 Nov 2024 21:15:07 +0100 Message-ID: <87ed38xpro.fsf@gmail.com> References: <875xotsqnm.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="34510"; 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 Mon Nov 18 21:30:56 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 1tD8Od-0008q2-Eu for ged-emacs-devel@m.gmane-mx.org; Mon, 18 Nov 2024 21:30:55 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tD8Ne-0007Xn-P5; Mon, 18 Nov 2024 15:29:54 -0500 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 1tD89Y-0006YG-MV for emacs-devel@gnu.org; Mon, 18 Nov 2024 15:15:20 -0500 Original-Received: from mail-wm1-x332.google.com ([2a00:1450:4864:20::332]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tD89W-0007TS-JH for emacs-devel@gnu.org; Mon, 18 Nov 2024 15:15:20 -0500 Original-Received: by mail-wm1-x332.google.com with SMTP id 5b1f17b1804b1-4315df7b43fso1084875e9.0 for ; Mon, 18 Nov 2024 12:15:17 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1731960916; x=1732565716; 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=5MZiG9uFCzE8lgpcExsTfG7WOg7UalZ87klkrlnjBPo=; b=aY3Xg5l+pEy9czpGKLzj6vym5hx0It5Ayj6/iwf0AauIL3f+frUzJmam5IrBcxdo3t FCrBVpqxPk//UKLEQKRqS18TWaMrxS6Jd9TxLBP5z/BaWQFDzKwcWSnLerPEb7pByPC/ 3lBO5AG1H+xq5GB4sKPx0riUbiSEGHUZBEX2tmC2KO4m/GXqjn4C0Qw0NF/UFE7W2sKB 1EpIQVDWuCLNwC2wSDzV03Uih8K0YIBfzNRf1FK6/aL8srtPfewcA5Q55Qco8X+hDx6m ZF2bWLVdE6dpMC0UTbG3dSBfGY1ryIkn62MLRUpHfZGYjoMpCA6at4PTQu8NcdiazsMQ 9j5A== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1731960916; x=1732565716; 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=5MZiG9uFCzE8lgpcExsTfG7WOg7UalZ87klkrlnjBPo=; b=sz07LIEjdD22keNxQ2MVMK4CffUNdRY3m48wLJtk3bMRSmx/7e5OgQyn3fCRFNXx3k R8FC0GshX5IMnbTVH4R8QkGJzWQ1dXGd5TVYNR8gDlSQ+M9Ybi6+l+zMQoIvC1NsMowL 1Rt9TJCa6booryPOkh3CoNjtMVDmiPno+PP2WFDwWv8mvrH6TsZv9n83MnO90TNBqgFL 2S+RbmOGFw9PxrRbwHYRIq91sujFjlAb4zAidoPw4tN1+pWdeESO9i22E7HgwQYWCL3t TW9/OINvctWBHsbtpxNDsz/Gf9UKfaj3flQc6/9sng0K70+UmDgvV0T+I5pJ20QCQKPo zRMw== X-Gm-Message-State: AOJu0Yz1mlAtoi/Hi0eayteE6NRi31Sb3p4TpN12BFQsODbcpB8nWVQD ncmKtXR6l5sxEHLQHcPGtYPenDNWIKas4A2umUoRlmECBR5k/LiaWfyzGSpLCVg= X-Google-Smtp-Source: AGHT+IFtaacKcdRdRe25hgZ6hm4FVWMx9yVKAENZEVi+mFwCteHBOf5rmY66XOqrDaIk0VJq2Ez+pg== X-Received: by 2002:a5d:6da9:0:b0:382:40ef:4323 with SMTP id ffacd0b85a97d-38240ef4415mr4738020f8f.45.1731960915986; Mon, 18 Nov 2024 12:15:15 -0800 (PST) Original-Received: from thuna-lis3 ([90.147.71.64]) by smtp.gmail.com with ESMTPSA id 5b1f17b1804b1-432dab788a2sm165699195e9.11.2024.11.18.12.15.14 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 18 Nov 2024 12:15:15 -0800 (PST) In-Reply-To: <875xotsqnm.fsf@gmail.com> Received-SPF: pass client-ip=2a00:1450:4864:20::332; envelope-from=thuna.cing@gmail.com; helo=mail-wm1-x332.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: Mon, 18 Nov 2024 15:29:53 -0500 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:325499 Archived-At: --=-=-= Content-Type: text/plain This makes a test in comp.el fail (I don't really understand why or how) but here's a possible way this could be implemented (which should also give a better insight into the sort of thing that I am thinking of): --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Unify-closure-allocators.patch >From 54e0af41949694191b5ef6c3a1f04efe206dc433 Mon Sep 17 00:00:00 2001 From: Thuna Date: Sun, 17 Nov 2024 18:28:38 +0100 Subject: [PATCH] Unify closure allocators --- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/oclosure.el | 2 +- src/alloc.c | 115 +++++++++++++++++++++++++++++++++++- src/data.c | 1 + src/eval.c | 36 ----------- 5 files changed, 117 insertions(+), 39 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f058fc48cc7..187955f92db 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4202,7 +4202,7 @@ byte-compile-make-closure ; have been stripped in ; `byte-compile-lambda'. opt-args)))) - `(make-closure ,proto-fun ,@env)) + `(copy-closure ,proto-fun ,@env)) ;; Nontrivial doc string expression: create a bytecode object ;; from small pieces at run time. `(make-byte-code diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 165d7c4b6e8..4c6b848227e 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -441,7 +441,7 @@ oclosure--fix-type (defun oclosure--copy (oclosure mutlist &rest args) (cl-assert (closurep oclosure)) (if (byte-code-function-p oclosure) - (apply #'make-closure oclosure + (apply #'copy-closure oclosure (if (null mutlist) args (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args))) diff --git a/src/alloc.c b/src/alloc.c index 4fab0d54248..2ab2d96af40 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3848,7 +3848,116 @@ and (optional) INTERACTIVE-SPEC. return val; } -DEFUN ("make-closure", Fmake_closure, Smake_closure, 1, MANY, 0, +Lisp_Object +make_closure (Lisp_Object argdesc, Lisp_Object code, Lisp_Object env, + Lisp_Object depth, Lisp_Object docstring, Lisp_Object iform) +{ + ptrdiff_t nargs; + Lisp_Object value, slots[6]; + + slots[CLOSURE_ARGLIST] = argdesc; + slots[CLOSURE_CODE] = code; + slots[CLOSURE_CONSTANTS] = env; + slots[CLOSURE_STACK_DEPTH] = depth; + slots[CLOSURE_DOC_STRING] = docstring; + slots[CLOSURE_INTERACTIVE] = iform; + + nargs = !NILP (iform) ? 6 + : !NILP (docstring) ? 5 + : !NILP (depth) ? 4 + : 3; + value = Fvector (nargs, slots); + XSETPVECTYPE (XVECTOR (value), PVEC_CLOSURE); + return value; +} + +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_LIST (args); + CHECK_CONS (body); + CHECK_LIST (iform); + + Lisp_Object ifcdr = CDR (iform); + if (NILP (CDR (ifcdr))) + iform = CAR (ifcdr); + else + iform = CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr)); + + return make_closure (args, body, env, Qnil, docstring, iform); +} + +DEFUN ("make-compiled-closure", Fmake_compiled_closure, + Smake_compiled_closure, 4, 6, 0, + doc: /* Create and return a byte-compiled closure. + +See `make-closure' for the meaning of the arguments. */) + (Lisp_Object argdesc, Lisp_Object bytecode, Lisp_Object constants, + Lisp_Object depth, Lisp_Object docstring, Lisp_Object iform) +{ + CHECK_TYPE (NILP (argdesc) || CONSP (argdesc) || FIXNUMP (argdesc), + list3 (Qor, Qlistp, Qfixnump), + argdesc); + CHECK_STRING (bytecode); + if (STRING_MULTIBYTE (bytecode)) + error ("Multibyte byte-code"); + CHECK_VECTOR (constants); + CHECK_FIXNAT (depth); + + /* Bytecode must be immovable. */ + pin_string (bytecode); + + return make_closure (argdesc, bytecode, constants, depth, docstring, iform); +} + +DEFUN ("make-closure", Fmake_closure, Smake_closure, 2, 6, 0, + doc: /* Create and return a closure object. + +ARGDESC is either be a lambda list that is recognized by `lambda', or a +fixnum of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the +minimum number of arguments, the 7-bit NNNNNNN specifies the maximum +number of arguments (ignoring &rest) and the R bit specifies whether +there is a &rest argument to catch the left-over arguments. ARGDESC can +only be an integer for byte compiled closures. + +For interpreted closures, CODE is a non-empty list of elisp forms which +make up the closure's body. For byte compiled closures, CODE is a +unibyte string containing the byte code instructions. + +For byte compiled closures, ENV holds the vector of elisp objects +referenced by the byte code. For interpreted closures, if the closure +uses dynamic scoping, ENV is nil, otherwise it is the lexical +environment, like the second argument of `eval'. + +For byte compiled closures, DEPTH is the maximum stack size needed. +DEPTH should be nil for interpreted closures. + +DOCSTRING, if non-nil, should be a string containing the documentation, +or a number or a list, in case the documentation is stored in a file. + +IFORM, if non-nil, should be a string or an elisp form. If nil, +the closure is non-interactive. */) + (Lisp_Object argdesc, Lisp_Object code, Lisp_Object env, + Lisp_Object depth, Lisp_Object docstring, Lisp_Object iform) +{ + if (CONSP (code)) + return Fmake_interpreted_closure + (argdesc, code, env, docstring, + NILP (iform) ? Qnil : list2 (Qinteractive, iform)); + else if (STRINGP (code)) + return Fmake_compiled_closure (argdesc, code, env, depth, docstring, iform); + else + wrong_type_argument (list3 (Qor, Qconsp, Qstringp), code); +} + +DEFUN ("copy-closure", Fcopy_closure, Scopy_closure, 1, MANY, 0, doc: /* Create a byte-code closure from PROTOTYPE and CLOSURE-VARS. Return a copy of PROTOTYPE, a byte-code object, with CLOSURE-VARS replacing the elements in the beginning of the constant-vector. @@ -8232,6 +8341,7 @@ syms_of_alloc (void) DEFSYM (Qvector_slots, "vector-slots"); DEFSYM (Qheap, "heap"); DEFSYM (QAutomatic_GC, "Automatic GC"); + DEFSYM (Qvalid_docstring_p, "valid-docstring-p"); DEFSYM (Qgc_cons_percentage, "gc-cons-percentage"); DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); @@ -8254,7 +8364,10 @@ syms_of_alloc (void) defsubr (&Srecord); defsubr (&Sbool_vector); defsubr (&Smake_byte_code); + defsubr (&Smake_interpreted_closure); + defsubr (&Smake_compiled_closure); defsubr (&Smake_closure); + defsubr (&Scopy_closure); defsubr (&Smake_list); defsubr (&Smake_vector); defsubr (&Smake_record); diff --git a/src/data.c b/src/data.c index 66cf34c1e60..83ecd040dca 100644 --- a/src/data.c +++ b/src/data.c @@ -4067,6 +4067,7 @@ syms_of_data (void) DEFSYM (Qoclosure_interactive_form, "oclosure-interactive-form"); DEFSYM (Qsubrp, "subrp"); + DEFSYM (Qclosurep, "closurep"); DEFSYM (Qunevalled, "unevalled"); DEFSYM (Qmany, "many"); diff --git a/src/eval.c b/src/eval.c index d0a2abf0089..836930259b0 100644 --- a/src/eval.c +++ b/src/eval.c @@ -517,41 +517,6 @@ 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) -{ - Lisp_Object ifcdr, value, slots[6]; - - CHECK_CONS (body); /* Make sure it's not confused with byte-code! */ - CHECK_LIST (args); - CHECK_LIST (iform); - ifcdr = CDR (iform); - if (NILP (CDR (ifcdr))) - value = CAR (ifcdr); - else - value = CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr)); - slots[0] = args; - slots[1] = body; - slots[2] = env; - slots[3] = Qnil; - slots[4] = docstring; - slots[5] = 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); - 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 @@ -4491,7 +4456,6 @@ 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); -- 2.44.2 --=-=-=--