From: Thuna <thuna.cing@gmail.com>
To: emacs-devel@gnu.org
Subject: Re: Getting rid of cl--block-wrapper and cl--block-throw
Date: Wed, 24 Jul 2024 18:14:38 +0200 [thread overview]
Message-ID: <871q3i6a35.fsf@gmail.com> (raw)
In-Reply-To: yp1y15rx8i0.fsf@fencepost.gnu.org
[-- Attachment #1: Type: text/plain, Size: 308 bytes --]
I am not privy to the historical details but looking at the logs it
looks like the previous code was written at a time when
`macroexpand-all' was not available and never touched afterwards.
What I have in mind is similar to the patch I've attached, though it
might be better to move this to bug-gnu-emacs.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch moving cl--block-{wrapper,throw} functionality into cl-{block,return-from} --]
[-- Type: text/x-patch, Size: 3060 bytes --]
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 2e501005bf7..31b88aec889 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -889,6 +889,8 @@ cl-etypecase
;;; Blocks and exits.
+(defvar cl--active-block-names nil)
+
;;;###autoload
(defmacro cl-block (name &rest body)
"Define a lexically-scoped block named NAME.
@@ -900,10 +902,12 @@ cl-block
references may appear inside macro expansions, but not inside functions
called from BODY."
(declare (indent 1) (debug (symbolp body)))
- (if (cl--safe-expr-p `(progn ,@body)) `(progn ,@body)
- `(cl--block-wrapper
- (catch ',(intern (format "--cl-block-%s--" name))
- ,@body))))
+ (let* ((cl-entry (list name (make-symbol (symbol-name name)) nil))
+ (cl--active-block-names (cons cl-entry cl--active-block-names))
+ (body (macroexpand-all (macroexp-progn body) macroexpand-all-environment)))
+ (if (nth 2 cl-entry) ; a corresponding cl-return was found
+ `(catch ',(nth 1 cl-entry) ,@(macroexp-unprogn body))
+ body)))
;;;###autoload
(defmacro cl-return (&optional result)
@@ -920,9 +924,14 @@ cl-return-from
This is compatible with Common Lisp, but note that `defun' and
`defmacro' do not create implicit blocks as they do in Common Lisp."
(declare (indent 1) (debug (symbolp &optional form)))
- (let ((name2 (intern (format "--cl-block-%s--" name))))
- `(cl--block-throw ',name2 ,result)))
-
+ (let ((cl-entry (assq name cl--active-block-names)))
+ (if (not cl-entry)
+ (macroexp-warn-and-return
+ (format "`cl-return-from' %S encountered with no corresponding `cl-block'" name)
+ ;; This will always be a no-catch
+ `(throw ',(make-symbol (symbol-name name)) ,result))
+ (setf (nth 2 cl-entry) t)
+ `(throw ',(nth 1 cl-entry) ,result))))
;;; The "cl-loop" macro.
@@ -3635,27 +3644,6 @@ cl-compiler-macroexpand
(not (eq form (setq form (apply handler form (cdr form))))))))
form)
-;; Optimize away unused block-wrappers.
-
-(defvar cl--active-block-names nil)
-
-(cl-define-compiler-macro cl--block-wrapper (cl-form)
- (let* ((cl-entry (cons (nth 1 (nth 1 cl-form)) nil))
- (cl--active-block-names (cons cl-entry cl--active-block-names))
- (cl-body (macroexpand-all ;Performs compiler-macro expansions.
- (macroexp-progn (cddr cl-form))
- macroexpand-all-environment)))
- ;; FIXME: To avoid re-applying macroexpand-all, we'd like to be able
- ;; to indicate that this return value is already fully expanded.
- (if (cdr cl-entry)
- `(catch ,(nth 1 cl-form) ,@(macroexp-unprogn cl-body))
- cl-body)))
-
-(cl-define-compiler-macro cl--block-throw (cl-tag cl-value)
- (let ((cl-found (assq (nth 1 cl-tag) cl--active-block-names)))
- (if cl-found (setcdr cl-found t)))
- `(throw ,cl-tag ,cl-value))
-
;; Compile-time optimizations for some functions defined in this package.
(defun cl--compiler-macro-member (form a list &rest keys)
prev parent reply other threads:[~2024-07-24 16:14 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-07-24 2:14 Getting rid of cl--block-wrapper and cl--block-throw Thuna
2024-07-24 12:46 ` Andrea Corallo
2024-07-24 16:14 ` Thuna [this message]
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=871q3i6a35.fsf@gmail.com \
--to=thuna.cing@gmail.com \
--cc=emacs-devel@gnu.org \
/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).