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.bugs Subject: bug#72344: [PATCH] Add a version of cl-once-only which handles lists of forms Date: Wed, 14 Aug 2024 04:21:32 +0200 Message-ID: <87v80326ab.fsf@gmail.com> References: <87y15l1aj8.fsf@gmail.com> <8734nsk72i.fsf@melete.silentflame.com> <87plqw0y9j.fsf@gmail.com> <87ikwi5neo.fsf@melete.silentflame.com> <871q35mdrd.fsf@gmail.com> <871q321l7d.fsf@melete.silentflame.com> <874j7xzvgx.fsf@gmail.com> <87r0b1su7p.fsf@melete.silentflame.com> <874j7o2kcq.fsf@gmail.com> <87zfpg3r4q.fsf@melete.silentflame.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="17554"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 72344@debbugs.gnu.org To: Sean Whitton Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Aug 14 04:23:52 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@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 1se3fz-0004QH-PC for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 14 Aug 2024 04:23:51 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1se3ff-0003Mp-9Z; Tue, 13 Aug 2024 22:23:31 -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 1se3fc-0003MZ-2J for bug-gnu-emacs@gnu.org; Tue, 13 Aug 2024 22:23:28 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1se3fb-0000AH-Px for bug-gnu-emacs@gnu.org; Tue, 13 Aug 2024 22:23:27 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:References:In-Reply-To:From:To:Subject; bh=EnhDh7awiuU+e+NPtaoqwzzppMQ1GRU8Q7jqB1mshMc=; b=HERQ3ksZEtoSj9MhxBONtHkyz7HkNijOtUVvaV1n5GQGqW17VZ1Flbe0CbWckBl31WVaUj1UVcoUCUTjHBjDyvFQu4kbG0pQgDBgpQwgmYLDB7OM8QllfhphvJMB8HW+KqC7SLi5NbanhPWwiDhso23ZF36hH36h7qc5SBgqa3JItw+12Iz7rzkArw+5uwmUtWLjgi4aqtWX3Tp63w7BagFyzKCeBvWk5LD5TWgsDo7+As2QlxE+ofOkrFM0+lTPIspD7zTdW2e3U0pe5k7hYnTQD634IF3udb8qTZzGv7ByJkXoPGVuHgK7nKTn/y9czuLaE2LutUD/Egff4fpDfQ==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1se3g9-0003TF-Uy for bug-gnu-emacs@gnu.org; Tue, 13 Aug 2024 22:24:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Thuna Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 14 Aug 2024 02:24:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72344 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 72344-submit@debbugs.gnu.org id=B72344.172360219813264 (code B ref 72344); Wed, 14 Aug 2024 02:24:01 +0000 Original-Received: (at 72344) by debbugs.gnu.org; 14 Aug 2024 02:23:18 +0000 Original-Received: from localhost ([127.0.0.1]:45782 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1se3fR-0003Rs-9y for submit@debbugs.gnu.org; Tue, 13 Aug 2024 22:23:17 -0400 Original-Received: from mail-ed1-f53.google.com ([209.85.208.53]:44459) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1se3fP-0003Rf-BU for 72344@debbugs.gnu.org; Tue, 13 Aug 2024 22:23:16 -0400 Original-Received: by mail-ed1-f53.google.com with SMTP id 4fb4d7f45d1cf-5bb8e62570fso7347584a12.1 for <72344@debbugs.gnu.org>; Tue, 13 Aug 2024 19:22:41 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1723602095; x=1724206895; darn=debbugs.gnu.org; h=mime-version:message-id:date:references:in-reply-to:subject:cc:to :from:from:to:cc:subject:date:message-id:reply-to; bh=EnhDh7awiuU+e+NPtaoqwzzppMQ1GRU8Q7jqB1mshMc=; b=Ko56gHQdfbVg0CULAECDU7DbWNwCeJ6/S1FeLmaB2oQbDG5eK16xRYRMCI6S9JJAt2 rR44AYWuACCBiFNU3HYhCD2gbaUS1Uw9vy6fvjnPCzugNc7l3+47c21EvpSJT/eCEsV9 TX3NyTxWA3eZTlGlnq3U12hmzg3tzQzvT+3PQrPEyZjft6cZBuDc9Nn0u+kI0mHJhioY 6R1v8QYa4xSopaexW+Grp4LNkoDanxW9qxNPMzLPc3QyWcoFDHpm3GZwqxxDA/xmns49 8M4RvleIpBrJIKjfIVFOPHNXldJ1pdTmiRMF9ujSQO4u+049+xgo6XdJAKVakeB/hF5y Ki+w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1723602095; x=1724206895; h=mime-version:message-id:date:references:in-reply-to:subject:cc:to :from:x-gm-message-state:from:to:cc:subject:date:message-id:reply-to; bh=EnhDh7awiuU+e+NPtaoqwzzppMQ1GRU8Q7jqB1mshMc=; b=P5OBU4e8I5R5WcgKHl4KngsTLCzCHNm9BpIPwWHjshlETripqepy7qLkocx8u8xb/3 IluElHDae/A7kQ65zrLQrgJ3zox2rmfN1P1KRJwJDNZVdNyCcDoKHhHCr+dcOds0hUq5 W7iZZlrkaArONtus7zQelzXVs5TbESlNuiRc+Ijahm4+l9OXp0LYESIFePSqB8rf05Gk CDq1/PhRPk/8JaURmAJtBEDjS7NYjGA11QFYsVlujJIsCUrjevyKYNGp6efqXxe/Lp3D QgKCoLmOVg9p6yWGDxQbBDOjfw0oNGMatl+/th1OrSETiQDy0PG9+d72Se4Dz7Q+aj/0 Tgzg== X-Gm-Message-State: AOJu0YwvcXflpTq1BiahkrWNPriual26VQtXptAaK/xf5OfVgfSfyJce 8y/u24uo251YJcU/DS96KqyJEgytP72tniJGswXONL9IW871Ou9CkyVmFEj0jDk= X-Google-Smtp-Source: AGHT+IFd6vljN/LrNMMUssTcTsiI11xiyCSEWK4hmz3Z8DBPciIhBoHXxQzWH2Ld0gy8Qmt0SbCJqQ== X-Received: by 2002:a05:6402:2789:b0:5a2:5bd2:ca50 with SMTP id 4fb4d7f45d1cf-5bea1cac6d8mr719318a12.25.1723602094566; Tue, 13 Aug 2024 19:21:34 -0700 (PDT) Original-Received: from thuna-lis3 ([85.106.105.81]) by smtp.gmail.com with ESMTPSA id 4fb4d7f45d1cf-5bd1a602da2sm3634534a12.93.2024.08.13.19.21.33 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 13 Aug 2024 19:21:33 -0700 (PDT) In-Reply-To: <87zfpg3r4q.fsf@melete.silentflame.com> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:290107 Archived-At: --=-=-= Content-Type: text/plain > You're not keen on either of my other suggestions, right? > > cl-once-only-many, cl-once-only-these No, I am really *really* not that enthusiastic about either of those names. `*-these' is completely out of the question, and `*-many' is... fine, but IMO sounds worse than `*-multiple'. > I guess I am hung up on how -multiple- is already used in CL names, > but it comes *before* the things that are multiple. But I believe you > don't like cl-multiple-once-only. `multiple' seems to be used exclusively in `cl-multiple-value-*' names, so there is some possibility that this might maybe be confused as a part of that suite, but I don't think it's a particularly significant one. > The interdiff isn't too helpful to me here. I'd prefer to review a > complete patch against master. Oops, sorry for the bad patch, I've attached the full diff. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=cl-texi-second-draft.patch diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 113029700ec..de9f0565d03 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -999,7 +999,7 @@ Control Structure * Iteration:: @code{cl-do}, @code{cl-dotimes}, @code{cl-dolist}, @code{cl-do-symbols}. * Loop Facility:: The Common Lisp @code{loop} macro. * Multiple Values:: @code{cl-values}, @code{cl-multiple-value-bind}, etc. -* Macro-Writing Macros:: @code{cl-with-gensyms}, @code{cl-once-only}. +* Macro-Writing Macros:: @code{cl-with-gensyms}, @code{cl-once-only}, @code{cl-once-only*}. @end menu @node Assignment @@ -2683,6 +2683,73 @@ Macro-Writing Macros @end example @end defmac +@defmac cl-once-only* (variable forms) body +This macro is a version of @code{cl-once-only} which takes an +arbitrarily long list of forms. This macro is primarily meant to be +used where the number of forms is unknown and thus @code{cl-once-only} +cannot work, such as those obtained by a @code{&body} argument. + +Each element of @var{variable} may be used to refer to the result of +evaluating the corresponding form in @var{forms} within @var{body}. +@code{cl-once-only*} binds @var{variable} to a list of fresh uninterned +symbols. @code{cl-once-only*} furthermore wraps the final expansion +such that each form is evaluated in order and its result is bound to the +corresponding symbol. + +Like @code{cl-once-only}, the first argument can be a symbol @var{variable}, which +is equivalent to writing @code{(variable variable)}. + +Consider the following macro: + +@example +(defmacro my-list (vals &rest forms) + (let ((val-results (mapcar (lambda (_) (gensym)) vals))) + `(let* ,(cl-mapcar #'list val-results vals) + (list ,(cl-first val-results) + ,(cl-second val-results) + ,@@val-results + (progn ,@@forms))))) +@end example + +In a call like @code{(my-list ((pop foo) (cl-incf bar) ...) ...)} the +@code{pop} and @code{cl-incf} will be evaluated exactly once, ensuring +their side effects are not applied twice. This code is however very +complex, in the same way code not using @code{cl-once-only} is. + +Using @code{cl-once-only} is not possible directly due to it expecting +individual forms which can be evaluated. This can be worked around by +assigning to a variable @code{`(list ,@@vars)} which @emph{can} be +evaluated: + +@example +(defmacro my-list (vals &rest forms) + (cl-once-only ((vals `(list ,@@vals))) + `(list (cl-first ,vals) + (cl-second ,vals) + ,vals ; Does not splice + (progn ,@@forms)))) +@end example + +There are two problems which both result from the fact that @code{vals} +is not a list inside the body of @code{cl-once-only}: 1. @code{vals} +cannot be spliced in the way it can in the previous example and +2. accessing individual elements of @code{vals} can only be done by +accessing the resulting list @emph{during evaluation}. Compare this to +the example using @code{cl-once-only*}: + +@example +(defmacro my-list (vals &rest forms) + (cl-once-only* vals + `(list ,(cl-first vals) + ,(cl-second vals) + ,@@vals + (progn ,@@forms)))) +@end example + +which preserves the fact the @var{vals} is a list and removes +boiler-plate code for generating and assigning temporary variables. +@end defmac + @node Macros @chapter Macros diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 2e501005bf7..adb9cb29104 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2544,6 +2544,54 @@ cl-once-only collect `(,(car name) ,gensym)) ,@body))))) +(defmacro cl-once-only* (listvar &rest body) + "Generate code to evaluate the list of FORMS just once in BODY. + +This is a macro to be used while defining other macros. FORMS is +evaluated once during macroexpansion to obtain the list of forms. In +the fully expanded code those forms will be evaluated once before BODY +and their results will be bound to fresh uninterned variables, one for +each form. + +Within the macro VARIABLE is a list of these symbols in order, such that +each form in FORMS can be accessed by using the corresponding element in +VARIABLE. + +The common case of `(cl-once-only* (VARIABLE VARIABLE) ...)' can be +written shortly as `(cl-once-only* VARIABLE ...)'. + +For example, the following macro: + + (defmacro my-list (head &rest args) + (cl-once-only* args + \\=`(list (,head ,@args) ,@args))) + +when called like + + (let ((x \\='(1 5 4))) + (my-list + (pop x) (1+ (pop x)) (1- (pop x)))) + +will expand into + + (let ((x \\='(1 5 4))) + (let* ((arg1 (pop x)) (arg2 (1+ (pop x))) (arg3 (1- (pop x)))) + (list (+ arg1 arg2 arg3) arg1 arg2 arg3))) + +and the arguments will be evaluated only once and in order. + +\(fn (VARIABLE FORMS) &body BODY)" + (declare (debug ([&or symbolp (symbolp form)] body)) (indent 1)) + (let* ((variable (if (symbolp listvar) listvar (nth 0 listvar))) + (forms (if (symbolp listvar) listvar (nth 1 listvar))) + (results* (gensym (symbol-name variable)))) + (cl-once-only (forms) + `(let ((,results* + (cl-loop for i from 1 to (length ,forms) collect + (make-symbol (format "%s$%d" ',(symbol-name variable) i))))) + `(let* ,(cl-mapcar #'list ,results* ,forms) + ,(let ((,variable ,results*)) + ,@body)))))) + ;;; Multiple values. ;;;###autoload --=-=-=--