From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#59786: Allowing arbitrary expressions in cl-labels Date: Fri, 02 Dec 2022 14:44:13 -0500 Message-ID: Reply-To: Stefan Monnier 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="20612"; mail-complaints-to="usenet@ciao.gmane.io" To: 59786@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Dec 02 20:45:23 2022 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 1p1ByM-000586-W3 for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 02 Dec 2022 20:45:23 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1p1By4-0002AT-4m; Fri, 02 Dec 2022 14:45:04 -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 1p1By2-0002AH-N6 for bug-gnu-emacs@gnu.org; Fri, 02 Dec 2022 14:45:02 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1p1By2-0003rk-CX for bug-gnu-emacs@gnu.org; Fri, 02 Dec 2022 14:45:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1p1By2-0000Vb-0T for bug-gnu-emacs@gnu.org; Fri, 02 Dec 2022 14:45:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 02 Dec 2022 19:45:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 59786 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.16700102751927 (code B ref -1); Fri, 02 Dec 2022 19:45:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 2 Dec 2022 19:44:35 +0000 Original-Received: from localhost ([127.0.0.1]:48472 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1p1Bxa-0000V1-Ko for submit@debbugs.gnu.org; Fri, 02 Dec 2022 14:44:35 -0500 Original-Received: from lists.gnu.org ([209.51.188.17]:36754) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1p1BxX-0000Uv-Ki for submit@debbugs.gnu.org; Fri, 02 Dec 2022 14:44:33 -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 1p1BxX-00027L-5v for bug-gnu-emacs@gnu.org; Fri, 02 Dec 2022 14:44:31 -0500 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1p1BxU-0003nD-JI for bug-gnu-emacs@gnu.org; Fri, 02 Dec 2022 14:44:30 -0500 Original-Received: from pmg1.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id 969C0100178 for ; Fri, 2 Dec 2022 14:44:25 -0500 (EST) Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id 40341100143 for ; Fri, 2 Dec 2022 14:44:23 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1670010263; bh=ygG05gcLZ+SDo7E6pzC9NP8ROSld7EA8xL1cemA/NfE=; h=From:To:Subject:Date:From; b=SPYLWX987WABGSL7zjz6c6OJ4LkAFm1kART330GTuKCVXHNrppaJQJQxF+Q79KNF8 AH6Q42uBl+dxP7wAff1jPfoAJZRyFgnd+66+SOgp2hw/fuAWI6a6Lc1akUuWPJOWSM NyheTgl73HhwAI0wG3n+zBU9Ue2NYFjJnfKl71rf/wY9W0iuetdcf++dG9w7J6MBWX m5PNwsyWebX05DLuIaU4M/Id4R4nOuw1AMzuQXDEBR4dFeeLPUatOI8LiPybLztIuj bB6MOqHTW8Y1zs7L2077cRVnZ2dyrP7yS4Ln9zJVZurSeti9qgDkphRRN3+BLnyZ6u I+N43NC+Nhdww== Original-Received: from pastel (unknown [45.72.193.52]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 2A8D3122D8E for ; Fri, 2 Dec 2022 14:44:23 -0500 (EST) Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action 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:249775 Archived-At: --=-=-= Content-Type: text/plain Tags: patch I have found some circumstances where I'd like to write things like: (cl-labels ((f1 (if blabla (lambda (x) (do one thing)) (lambda (x) (do another thing)))) (f2 (if bleble (lambda (y) (do some thing)) (lambda (y) (do some other thing))))) ...) I.e. define two, mutually-recursive functions, but where I want to perform some computation before "building/returning" each function. I could rewrite the above to (cl-labels ((f1 (x) (if blabla (do one thing) (do another thing))) (f2 (y) (if bleble (do some thing) (do some other thing)))) ...) but then the `if` tests are repeated at each call. I could also rewrite it to (letrec ((f1 (if blabla (lambda (x) (do one thing)) (lambda (x) (do another thing)))) (f2 (if bleble (lambda (y) (do some thing)) (lambda (y) (do some other thing))))) ...) but then I have to use (funcall f1 ..) and (funcall f2 ...) instead of just (f1 ...) and (f2 ...). I could add a (cl-flet ((f1 f1) (f2 f2)) ...) but that's inconvenient, especially because I'd have to add it in various places. So I'd like to propose to extend `cl-labels` in the same way that `cl-flet` was extended to allow each function to be defined by an expression that returns a function rather than by "args + body". One option is to use the same approach as I used in `cl-flet`, i.e. allow each binding to be either (FUNC ARGS BODY...) the normal existing syntax or (FUNC EXP) the new syntax After I introduced this in `cl-flet` it was pointed out that it was an incompatible change since BODY... can be the empty list. Another option is to use a syntax like: (FUNC = EXP) the new new syntax which should not suffer from such incompatibility since ARGS should never be of the form `=`. The patch below uses this "new new" syntax (and adjusts `cl-flet` to also support this new new syntax). It still lacks a NEWS entry (as well as updating the CL manual), but before I do that, I'd like to hear what other people think, Stefan In GNU Emacs 30.0.50 (build 1, x86_64-pc-linux-gnu, X toolkit, cairo version 1.16.0, Xaw3d scroll bars) of 2022-11-29 built on pastel Repository revision: 4254a4a71d5d04cfcefaedfefe5d22af55650a6a Repository branch: work Windowing system distributor 'The X.Org Foundation', version 11.0.12011000 System Description: Debian GNU/Linux 11 (bullseye) Configured using: 'configure -C --enable-checking --enable-check-lisp-object-type --with-modules --with-cairo --with-tiff=ifavailable 'CFLAGS=-Wall -g3 -Og -Wno-pointer-sign' PKG_CONFIG_PATH=/home/monnier/lib/pkgconfig' --=-=-= Content-Type: text/patch Content-Disposition: attachment; filename=cl-labels.patch diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 43a2ed92059..cc8c98f2264 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2028,11 +2028,11 @@ cl--labels-convert ;;;###autoload (defmacro cl-flet (bindings &rest body) "Make local function definitions. -Each definition can take the form (FUNC EXP) where +Each definition can take the form (FUNC = EXP) where FUNC is the function name, and EXP is an expression that returns the function value to which it should be bound, or it can take the more common form (FUNC ARGLIST BODY...) which is a shorthand -for (FUNC (lambda ARGLIST BODY)). +for (FUNC = (lambda ARGLIST BODY)). FUNC is defined only within FORM, not BODY, so you can't write recursive function definitions. Use `cl-labels' for that. See @@ -2055,8 +2055,12 @@ cl-flet (if (and (= (length args-and-body) 1) (symbolp (car args-and-body))) ;; Optimize (cl-flet ((fun var)) body). (setq var (car args-and-body)) - (push (list var (if (= (length args-and-body) 1) - (car args-and-body) + (push (list var (cond + ((= (length args-and-body) 1) ;Obsolete syntax. + (car args-and-body)) + ((eq '= (car args-and-body)) + (macroexp-progn (cdr args-and-body))) + (t `(cl-function (lambda . ,args-and-body)))) binds)) (push (cons (car binding) @@ -2203,12 +2207,13 @@ cl--self-tco ;;;###autoload (defmacro cl-labels (bindings &rest body) "Make local (recursive) function definitions. -+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where -FUNC is the function name, ARGLIST its arguments, and BODY the -forms of the function body. FUNC is defined in any BODY, as well -as FORM, so you can write recursive and mutually recursive -function definitions. See info node `(cl) Function Bindings' for -details. +BINDINGS is a list of definitions of the form either: +- (FUNC ARGLIST BODY...) where FUNC is the function name, + ARGLIST its arguments, and BODY the forms of the function body. +- (FUNC = BODY) where BODY is an expression that evaluates to a function. +FUNC is defined in any BODY, as well as FORM, so you can write recursive +and mutually recursive function definitions. +See info node `(cl) Function Bindings' for details. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug cl-flet)) @@ -2226,17 +2231,31 @@ cl-labels (unless (assq 'function newenv) (push (cons 'function #'cl--labels-convert) newenv)) ;; Perform self-tail call elimination. - (setq binds (mapcar - (lambda (bind) - (pcase-let* - ((`(,var ,sargs . ,sbody) bind) - (`(function (lambda ,fargs . ,ebody)) - (macroexpand-all `(cl-function (lambda ,sargs . ,sbody)) - newenv)) - (`(,ofargs . ,obody) - (cl--self-tco var fargs ebody))) - `(,var (function (lambda ,ofargs . ,obody))))) - (nreverse binds))) + (setq binds + (mapcar + (lambda (bind) + (pcase-let* + ((`(,var ,sargs . ,sbody) bind)) + (list var + (named-let loop + ((mfunexp (macroexpand-all + (if (eq '= sargs) + (macroexp-progn sbody) + `(cl-function (lambda ,sargs . ,sbody))) + newenv))) + (pcase mfunexp + (`#'(lambda ,fargs . ,ebody) + `#'(lambda . ,(cl--self-tco var fargs ebody))) + (`(progn . ,exps) + `(progn ,@(butlast exps) ,(loop (car (last exps))))) + (`(let ,bindings ,exps) + `(let ,bindings + ,@(butlast exps) ,(loop (car (last exps))))) + (`(if ,exp1 ,exp2 ,exps) + `(if ,exp1 ,(loop exp2) + ,@(butlast exps) ,(loop (car (last exps))))) + (_ mfunexp)))))) + (nreverse binds))) `(letrec ,binds . ,(macroexp-unprogn (macroexpand-all --=-=-=--