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: Sun, 27 Oct 2024 23:07:45 -0400 Message-ID: References: <87r0vybl6f.fsf@web.de> 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="40555"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: 59786@debbugs.gnu.org To: Michael Heerdegen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Oct 28 04:08:54 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 1t5G7h-000ARq-Iy for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 28 Oct 2024 04:08:53 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1t5G7J-0003nQ-68; Sun, 27 Oct 2024 23:08:30 -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 1t5G7H-0003nF-8R for bug-gnu-emacs@gnu.org; Sun, 27 Oct 2024 23:08:27 -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 1t5G7H-0004rh-0J for bug-gnu-emacs@gnu.org; Sun, 27 Oct 2024 23:08: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=uPoNEB+YLR9PEGTvN/H9+8DBfVE37WB8EfjFYWepl8o=; b=U2iyACuOJsds6X3QvRt7iVcYNruHit066Qse16h74VXIsCSMM/i64M+Pnq4vzO7NADnq+9voqT3oIzc44yKawm4CrU+I9s2HXGniOSUAmnFD4iPwSI99VWi8A+6Zcmub+voZarkC+BSfUTgvS8R6qODh+aGhSHn7CcbX/zMMS8ssYMTuXz1mwVpXE5C+d6zSoQqJm8YnFhTztf8BgXV0DCj9zyXUrUE5iUEbutXzSuBSuB1uGGnQKBgs8nANRplAdPnuGuad+birSWR9HnVojtUmA2aPCbFlHUwHh6/hisPQOlb2vVrPxNvvz52qpsaCi2m3CsUXocYPZnwucNYB2g==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1t5G7q-00006I-9h for bug-gnu-emacs@gnu.org; Sun, 27 Oct 2024 23:09:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 28 Oct 2024 03:09:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 59786 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 59786-submit@debbugs.gnu.org id=B59786.1730084922338 (code B ref 59786); Mon, 28 Oct 2024 03:09:02 +0000 Original-Received: (at 59786) by debbugs.gnu.org; 28 Oct 2024 03:08:42 +0000 Original-Received: from localhost ([127.0.0.1]:49458 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t5G7V-00005N-QG for submit@debbugs.gnu.org; Sun, 27 Oct 2024 23:08:42 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:22742) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t5G7S-00004y-FZ for 59786@debbugs.gnu.org; Sun, 27 Oct 2024 23:08:39 -0400 Original-Received: from pmg3.iro.umontreal.ca (localhost [127.0.0.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 1AB7E442EA3; Sun, 27 Oct 2024 23:07:56 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1730084874; bh=jce2fPgv5fvMXoiH1PKHlsExVSlLLe7gntyTP8/ynI0=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=nK6BcWJDCmfEejC0cqwYZqoDPTXNdNdlL43jTQzrB3fIgiF/2bvTHUL0shM6wtLuY jXCn+kThHDa2UDl676onkNTr0EHfogh/p6tLG5GbbOymj+yOOT/oLs0OMeE/UJFeKH GeolYCg5nH0WqMFnKP+TG+4hiF3V5Pu+iG/b+kZqdlGkkT62fwmygE36+trXCX0G7q p3b1A895UnlgYL4F5A9jGkFNNmLoq8zUAlrKk+Y9sdGcx72FpWJFKOLeoWwfsfPfbK 6pmD7Pow7hKqN/6YqovEFBaMtkazP9SbA6pra7Xx5A/GeYwgx16FIUEiX5r0QAiqQf oG6BKui1jPi2g== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 64B9B442DDB; Sun, 27 Oct 2024 23:07:54 -0400 (EDT) Original-Received: from pastel (unknown [69.196.161.60]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 3807912034F; Sun, 27 Oct 2024 23:07:54 -0400 (EDT) In-Reply-To: <87r0vybl6f.fsf@web.de> (Michael Heerdegen's message of "Fri, 13 Jan 2023 14:47:52 +0100") 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:294405 Archived-At: --=-=-= Content-Type: text/plain Michael Heerdegen [2023-01-13 14:47:52] wrote: > Stefan Monnier writes: >> 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, > > I like the idea to implement this kind of feature for `cl-labels'. It's > a good change IMO. > > I don't like the syntax I think (ugly). The rest of this answer is > discussing this detail: > > I don't recall all details about the ambiguity of the empty body case, > so forgive me if I'm missing something. > > A binding like (my-fun (var1 var2)) with an empty body would give you > compiler warnings anyway. Would this be an alternative to your "=" > style syntax: > > To specify a local function with an empty body one would have to use > local variable names starting with "_": > > (my-fun (_var1 _var2)) > > If not all variables start with an underscore or not all list members > are symbols, the binding is interpreted as specifying an expression > evaluating to the function to bind. This assumes that "_var" never > specifies a named function. I guess you're right. So we should just use the (FUNC EXP) syntax, exactly like we already do for `cl-flet`. The patch below does that. Stefan --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=cl-labels.patch diff --git a/etc/NEWS b/etc/NEWS index d1c7303f976..562c9c6bdc3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -215,6 +215,11 @@ modal editing packages. * Changes in Specialized Modes and Packages in Emacs 31.1 +** CL-Lib ++++ +*** 'cl-labels' now also accepts (FUNC EXP) bindings, like 'cl-flet'. +Such bindings make it possible to compute which function to bind to FUNC. + ** Whitespace --- diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index b37f744b175..388281e4b1a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2250,9 +2250,11 @@ 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 +BINDINGS is a list of definitions of the form either (FUNC EXP) +where EXP is a form that should return the function to bind to the +function name FUNC, or (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 +forms of the function body. FUNC is defined in any BODY or EXP, as well as FORM, so you can write recursive and mutually recursive function definitions. See info node `(cl) Function Bindings' for details. @@ -2273,18 +2275,21 @@ 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))) - `(letrec ,binds + `(letrec ,(mapcar + (lambda (bind) + (pcase-let* ((`(,var ,sargs . ,sbody) bind)) + `(,var + ,(if (null sbody) + ;; This is a (FUNC EXP) definition. + (macroexpand-all sargs newenv) + (pcase-let* + ((`(function (lambda ,fargs . ,ebody)) + (macroexpand-all + `(cl-function (lambda ,sargs . ,sbody)) newenv)) + (`(,ofargs . ,obody) + (cl--self-tco var fargs ebody))) + `(function (lambda ,ofargs . ,obody))))))) + (nreverse binds)) . ,(macroexp-unprogn (macroexpand-all (macroexp-progn body) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 14ff8628fb8..376ccebef98 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -558,5 +558,14 @@ cl-constantly (should (equal (mapcar (cl-constantly 3) '(a b c d)) '(3 3 3 3)))) +(ert-deftest cl-lib-test-labels () + (should (equal (cl-labels ((even (x) (if (= x 0) t (odd (1- x)))) + (odd (x) (if (= x 0) nil (even (1- x))))) + (list (even 42) (odd 42))) + '(t nil))) + (should (equal (cl-labels ((even (lambda (x) (if (= x 0) t (odd (1- x))))) + (odd (lambda (x) (if (= x 0) nil (even (1- x)))))) + (list (even 42) (odd 42))) + '(t nil)))) ;;; cl-lib-tests.el ends here --=-=-=--