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#74870: cl-labels and cl-flet don't create named blocks Date: Sat, 21 Dec 2024 10:44:04 -0500 Message-ID: References: <86bjxetdbp.fsf@gnu.org> Reply-To: Stefan Monnier Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="30783"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Eli Zaretskii , 74870@debbugs.gnu.org To: Jan Jouleodov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Dec 21 16:45:31 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 1tP1fV-0007rd-OL for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 21 Dec 2024 16:45:30 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tP1f7-0005rs-NS; Sat, 21 Dec 2024 10:45:05 -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 1tP1f6-0005qh-If for bug-gnu-emacs@gnu.org; Sat, 21 Dec 2024 10:45:04 -0500 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 1tP1f4-0006Qk-B4 for bug-gnu-emacs@gnu.org; Sat, 21 Dec 2024 10:45:03 -0500 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=MU97hlMgP7juyXuJ1HqyiHFRjWKNAGVjGYq80HxpQGM=; b=ZpQkhRa/NIYs4m5vuCBWlXqiTlJgrjSAcim6Rji49seAiO9BVEmXnQZf4wwfhPHi72msj4OmK3ofvmdPohAY/MYzZAqF0RmxDUcUf6q+HvkzAfmogLBxmzx4d1vykJJ2YwRBa6sXNhmhDGPCcnHIAcuZVvhKos5L+Ia0IqN5S59La0oC174fD21pq6LC0KMnwYowwBbrspPEaail4E4ksj1bPZR4gpTv6RmQwWLJuFJYtSBx2U4OIJ6adw3DGS7VTYBTrhi870puKTqvVOwuMuLpSB33x28RW9kwbEo1qjQwG5BobJboA/kZWBEsWW2F9p1ZwcQ9Q5g6U5KGUYrSKQ==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tP1f3-0001UI-RH for bug-gnu-emacs@gnu.org; Sat, 21 Dec 2024 10:45:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 21 Dec 2024 15:45:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 74870 X-GNU-PR-Package: emacs Original-Received: via spool by 74870-submit@debbugs.gnu.org id=B74870.17347958545635 (code B ref 74870); Sat, 21 Dec 2024 15:45:01 +0000 Original-Received: (at 74870) by debbugs.gnu.org; 21 Dec 2024 15:44:14 +0000 Original-Received: from localhost ([127.0.0.1]:47345 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP1eI-0001Sp-8A for submit@debbugs.gnu.org; Sat, 21 Dec 2024 10:44:14 -0500 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:26932) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP1eG-0001Sc-Nf for 74870@debbugs.gnu.org; Sat, 21 Dec 2024 10:44:13 -0500 Original-Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 054DF80837; Sat, 21 Dec 2024 10:44:07 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1734795846; bh=KhQTwNyIPuQYVYTxJB73altsdMey7g1xt7H/EhcX7a8=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=JXK5DxffLvh7m4q6mAAyh3AFhfSA6V1T5vxOmWg+4wnwVkyzs2d2YWap4dU4xRWZs XFB0kjqP+4tDf2BHAoNC0ka5bTQj21Jtd4HNlgAe13gPPGbtG9RK/WXP2zfRA2lgxA 9sKF98YYH6wgp118OXmRC9hqC5/SaZuDy0Lh6wYsGa7fH4IJgijJuEpkwnj8SXDIrr XTSn4QuGOxZhoVJRlj4SDzWDTpwIMgprV6Haj05EVdq35qlAHfsZNAmrPqta1ZARHk mux/8DbFXdJ8Xtrea0jcr4awwZCsjf8BqxAtXIkcjvXlDtUwZOhiCM36pER3zBFls+ uj7ZKcyVI7wEA== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 05F9E80289; Sat, 21 Dec 2024 10:44:06 -0500 (EST) Original-Received: from asado (unknown [199.119.74.1]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id BEDC612023C; Sat, 21 Dec 2024 10:44:05 -0500 (EST) In-Reply-To: (Jan Jouleodov's message of "Thu, 19 Dec 2024 00:55:34 +0000") 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:297533 Archived-At: > Is there any reason why one would not want to *always* emulate the CL > behavior in cl-lib? I could only think of a backward compatibility > problem before CL was standardized, but I am not familiar with the time > frame of cl-lib to know if that's really the case. Could you try the patch below? Stefan diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 65bc2cb9173..73741417383 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2096,15 +2096,22 @@ cl-flet cl-declarations body))) (let ((binds ()) (newenv macroexpand-all-environment)) (dolist (binding bindings) - (let ((var (make-symbol (format "--cl-%s--" (car binding)))) - (args-and-body (cdr binding))) - (if (and (= (length args-and-body) 1) - (macroexp-copyable-p (car args-and-body))) + (let* ((var (make-symbol (format "--cl-%s--" (car binding)))) + (args-and-body (cdr binding)) + (args (car args-and-body)) + (body (cdr args-and-body))) + (if (and (null body) + (macroexp-copyable-p args)) ;; 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) - `(cl-function (lambda . ,args-and-body)))) + (setq var args) + (push (list var (if (null body) + args + (let ((parsed-body (macroexp-parse-body body))) + `(cl-function + (lambda ,args + ,@(car parsed-body) + (cl-block ,(car binding) + ,@(cdr parsed-body))))))) binds)) (push (cons (car binding) (lambda (&rest args) @@ -2300,7 +2307,13 @@ cl-labels var (macroexpand-all (if (null sbody) sargs ;A (FUNC EXP) definition. - `(cl-function (lambda ,sargs . ,sbody))) + (let ((parsed-body + (macroexp-parse-body sbody))) + `(cl-function + (lambda ,sargs + ,@(car parsed-body) + (cl-block ,var + ,@(cdr parsed-body)))))) newenv))))) (nreverse binds)) . ,(macroexp-unprogn