unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: Michael Heerdegen <michael_heerdegen@web.de>
Cc: 59786@debbugs.gnu.org
Subject: bug#59786: Allowing arbitrary expressions in cl-labels
Date: Sun, 27 Oct 2024 23:07:45 -0400	[thread overview]
Message-ID: <jwv1q01lynb.fsf-monnier+emacs@gnu.org> (raw)
In-Reply-To: <87r0vybl6f.fsf@web.de> (Michael Heerdegen's message of "Fri, 13 Jan 2023 14:47:52 +0100")

[-- Attachment #1: Type: text/plain, Size: 1362 bytes --]

Michael Heerdegen [2023-01-13 14:47:52] wrote:
> Stefan Monnier <monnier@iro.umontreal.ca> 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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: cl-labels.patch --]
[-- Type: text/x-diff, Size: 3779 bytes --]

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.
 \f
 * 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

  reply	other threads:[~2024-10-28  3:07 UTC|newest]

Thread overview: 8+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-12-02 19:44 bug#59786: Allowing arbitrary expressions in cl-labels Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-12-02 20:29 ` Drew Adams
2023-01-13 13:47 ` Michael Heerdegen
2024-10-28  3:07   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2024-10-29 12:28     ` Michael Heerdegen via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-29 14:51       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-29 15:49         ` Michael Heerdegen via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-01-15 17:11 ` Sean Whitton

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=jwv1q01lynb.fsf-monnier+emacs@gnu.org \
    --to=bug-gnu-emacs@gnu.org \
    --cc=59786@debbugs.gnu.org \
    --cc=michael_heerdegen@web.de \
    --cc=monnier@iro.umontreal.ca \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).