bug#72279: [PATCH] Non-local exits from outside the lexical scope are caught by cl-block

bug#72279: [PATCH] Non-local exits from outside the lexical scope are caught by cl-block

[Thuna]

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

Since the thrown and caught tags in `cl-block' and `cl-return-from' are
interned and deterministic, a `cl-block' catches `cl-return-from's with
the corresponding names even from outside the current lexical scope.

The only mechanism in place to stop this is the compiler macro around
cl--block-catch, which removes the block if no approriate returns are
found, however not only is this bound to break if the compiler macro
fails to expand, a valid exit is all that is needed to work around this.

  (defun foo () (cl-return "ruh roh"))
  (cl-block nil (foo) (cl-return t)) ; => "ruh ruh"

The first patch attached attempts to solve this by moving the
functionality of the wrapper compiler macros to the macros themselves
and by using uninterned symbols for the thrown and caught tags,
communicated by the block to the corresponding returns.  All the
existing tests seemed to run just fine but I did not do any
comprehensive testing (and there doesn't appear to be any relevant
suites either).

I do take minor issue with `macroexpand-all'ing all things inside a
block, making debugging via macrostep really annoying, but I don't know
of a better solution, outside of communicating the tag during
evaluation, which would look something like the second patch.

PS. I would also like to have a discussion about a problem that I have
noticed when trying to build with the second patch, maybe here maybe in
another bug: Because struct slots are defined using `cl-defsubst', the
whole body is wrapped in a `cl-block'.  The only reason `setf' works
with such slots is because `cl-block' expands into the body itself when
there are no `cl-return's.  If it were to instead expand into a `catch'
- whether because there is a `cl-return' or because `cl-block' is
modified to always expandi into a `catch' as it is in my second patch -
the setf will expand into (setf catch) which is not defined.  I see two
possible solutions, either define a (setf catch) or switch to defsubst
instead of cl-defsubst.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The first patch --]
[-- Type: text/x-patch, Size: 4680 bytes --]

From 4027c50645260a202e45a2a074dfeb48468394c1 Mon Sep 17 00:00:00 2001
From: Thuna <thuna.cing@gmail.com>
Date: Wed, 24 Jul 2024 18:41:25 +0200
Subject: [PATCH 1/2] Use uninterned tags in cl-block, remove block wrappers

* lisp/emacs-lisp/cl-macs.el (cl-block): Macroexpand the body with its
tag in cl--active-block-names, if any `cl-return-from' or `cl-return'
with the appropriate name is found then have them throw the communicated
tag, otherwise simply return the body itself.
(cl-return-from): If a block was established with the appropriate name,
use throw using its tag.  Otherwise use a newly created tag which is
guaranteed to signal a no-catch and emit a macroexpand warning.
(cl--block-wrapper cl--block-throw): Remove compiler macros.
* lisp/emacs-lisp/cl-lib.el (cl--block-wrapper cl--block-throw): Remove
aliases.  Remove the now empty "Blocks and exits" section.
---
 lisp/emacs-lisp/cl-lib.el  |  6 ------
 lisp/emacs-lisp/cl-macs.el | 44 ++++++++++++++------------------------
 2 files changed, 16 insertions(+), 34 deletions(-)

diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 108dcd31f48..56c05aa0db3 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -183,12 +183,6 @@ substring
                                            ,getter ,start ,end ,v))
                         ,v))))))))
 
-;;; Blocks and exits.
-
-(defalias 'cl--block-wrapper 'identity)
-(defalias 'cl--block-throw 'throw)
-
-
 ;;; Multiple values.
 ;; True multiple values are not supported, or even
 ;; simulated.  Instead, cl-multiple-value-bind and friends simply expect
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)
-- 
2.44.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: The second patch --]
[-- Type: text/x-patch, Size: 2867 bytes --]

From 8181df542b1f57365b0a2a503b245884cb8da94d Mon Sep 17 00:00:00 2001
From: Thuna <thuna.cing@gmail.com>
Date: Wed, 24 Jul 2024 18:47:40 +0200
Subject: [PATCH 2/2] Avoid macroexpanding in cl-block

* lisp/emacs-lisp/cl-macs.el (cl-block): Communicate the tag during
evaluation via a lexical variable using the symbol kept in
`cl--active-block-names-var'.
(cl-return-from): Obtain the tag to throw by looking at the lexical
variable represented by the symbol kept in `cl--active-block-names-var'.
(cl--active-block-names): Remove variable.
(cl--active-block-names-var): Add variable.
---
 lisp/emacs-lisp/cl-macs.el | 26 +++++++++++---------------
 1 file changed, 11 insertions(+), 15 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 31b88aec889..07fc8ba7e73 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -889,7 +889,7 @@ cl-etypecase
 
 ;;; Blocks and exits.
 
-(defvar cl--active-block-names nil)
+(defvar cl--active-block-names-var '#:cl--active-block-names)
 
 ;;;###autoload
 (defmacro cl-block (name &rest body)
@@ -902,12 +902,12 @@ cl-block
 references may appear inside macro expansions, but not inside functions
 called from BODY."
   (declare (indent 1) (debug (symbolp 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)))
+  (let ((block-name (make-symbol (symbol-name name))))
+    `(let ((,cl--active-block-names-var
+            (cl-acons ',name ',block-name
+                      (ignore-error void-variable
+                        ,cl--active-block-names-var))))
+       (catch ',block-name ,@body))))
 
 ;;;###autoload
 (defmacro cl-return (&optional result)
@@ -924,14 +924,10 @@ 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 ((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))))
+  `(let ((block-name
+          (cdr (assq ',name (ignore-error void-variable
+                              ,cl--active-block-names-var)))))
+     (throw (or block-name ',(make-symbol (symbol-name name))) ,result)))
 
 ;;; The "cl-loop" macro.
 
-- 
2.44.2

bug#72279: [PATCH] Non-local exits from outside the lexical scope are caught by cl-block

[Andrea Corallo]

Thuna <thuna.cing@gmail.com> writes:

> Since the thrown and caught tags in `cl-block' and `cl-return-from' are
> interned and deterministic, a `cl-block' catches `cl-return-from's with
> the corresponding names even from outside the current lexical scope.
>
> The only mechanism in place to stop this is the compiler macro around
> cl--block-catch, which removes the block if no approriate returns are
> found, however not only is this bound to break if the compiler macro
> fails to expand, a valid exit is all that is needed to work around this.
>
>   (defun foo () (cl-return "ruh roh"))
>   (cl-block nil (foo) (cl-return t)) ; => "ruh ruh"

Hi Thuna,

yes I agree this is not optimal.  We should not even get to evaluating
the second form as we should error on the first (I think your patch
does that).

> The first patch attached attempts to solve this by moving the
> functionality of the wrapper compiler macros to the macros themselves
> and by using uninterned symbols for the thrown and caught tags,
> communicated by the block to the corresponding returns.  All the
> existing tests seemed to run just fine but I did not do any
> comprehensive testing (and there doesn't appear to be any relevant
> suites either).

Have you tried some general use with Emacs compiled with this patch?

> I do take minor issue with `macroexpand-all'ing all things inside a
> block, making debugging via macrostep really annoying, but I don't know
> of a better solution, outside of communicating the tag during
> evaluation, which would look something like the second patch.


IIUC installing first.patch we keep the same capability of cleaning-up
all un-necessary catches if no approriate throws are found correct?

> PS. I would also like to have a discussion about a problem that I have
> noticed when trying to build with the second patch, maybe here maybe in
> another bug: Because struct slots are defined using `cl-defsubst', the
> whole body is wrapped in a `cl-block'.  The only reason `setf' works
> with such slots is because `cl-block' expands into the body itself when
> there are no `cl-return's.  If it were to instead expand into a `catch'
> - whether because there is a `cl-return' or because `cl-block' is
> modified to always expandi into a `catch' as it is in my second patch -
> the setf will expand into (setf catch) which is not defined.  I see two
> possible solutions, either define a (setf catch) or switch to defsubst
> instead of cl-defsubst.
>
>>From 4027c50645260a202e45a2a074dfeb48468394c1 Mon Sep 17 00:00:00 2001
> From: Thuna <thuna.cing@gmail.com>
> Date: Wed, 24 Jul 2024 18:41:25 +0200
> Subject: [PATCH 1/2] Use uninterned tags in cl-block, remove block wrappers
>

[...]

> 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)

I think would be nice to document this variable with how its content is
supposed to look like.

I'm Ccing Stefan maybe he has opinions on these patches.

Also I don't see you in the copyright file.  Would you like to do the
FSF paperwork in order to be able to contribute non trivial patches to
Emacs?

Thanks!

  Andrea

bug#72279: [PATCH] Non-local exits from outside the lexical scope are caught by cl-block

[Thuna]

> >   (defun foo () (cl-return "ruh roh"))
> >   (cl-block nil (foo) (cl-return t)) ; => "ruh ruh"
> 
> yes I agree this is not optimal.  We should not even get to evaluating
> the second form as we should error on the first (I think your patch
> does that).

Yes, with my first patch applied, the call to `foo' signals a `no-catch'
in (cl-return "ruh roh").  It also emits a warning while macroexpanding.

> > The first patch attached attempts to solve this by moving the
> > functionality of the wrapper compiler macros to the macros themselves
> > and by using uninterned symbols for the thrown and caught tags,
> > communicated by the block to the corresponding returns.  All the
> > existing tests seemed to run just fine but I did not do any
> > comprehensive testing (and there doesn't appear to be any relevant
> > suites either).
> 
> Have you tried some general use with Emacs compiled with this patch?

No, sorry, I didn't.  I am currently working on a different thing which
changes the definitions for these macros yet again so I proposed this
more as an interliminary change so that my later changes don't end up
moving where cl-block is calculated AND modify what it does all in one
step.

> > I do take minor issue with `macroexpand-all'ing all things inside a
> > block, making debugging via macrostep really annoying, but I don't know
> > of a better solution, outside of communicating the tag during
> > evaluation, which would look something like the second patch.
>  
> IIUC installing first.patch we keep the same capability of cleaning-up
> all un-necessary catches if no approriate throws are found correct?

Correct, I have not changed that behavior; if no appropriate
`cl-return-from's are found within the body of the `cl-block', then the
`cl-block' simply expands into the (macroexpanded, though that can be
fixed) body.

> > PS. I would also like to have a discussion about a problem that I have
> > noticed when trying to build with the second patch, maybe here maybe in
> > another bug: Because struct slots are defined using `cl-defsubst', the
> > whole body is wrapped in a `cl-block'.  The only reason `setf' works
> > with such slots is because `cl-block' expands into the body itself when
> > there are no `cl-return's.  If it were to instead expand into a `catch'
> > - whether because there is a `cl-return' or because `cl-block' is
> > modified to always expandi into a `catch' as it is in my second patch -
> > the setf will expand into (setf catch) which is not defined.  I see two
> > possible solutions, either define a (setf catch) or switch to defsubst
> > instead of cl-defsubst.
> >
> >>From 4027c50645260a202e45a2a074dfeb48468394c1 Mon Sep 17 00:00:00 2001
> > From: Thuna <thuna.cing@gmail.com>
> > Date: Wed, 24 Jul 2024 18:41:25 +0200
> > Subject: [PATCH 1/2] Use uninterned tags in cl-block, remove block wrappers
> >
> 
> [...]
> 
> > 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)
> 
> I think would be nice to document this variable with how its content is
> supposed to look like.

This was a variable which already existed; I simply moved it here,
though I wouldn't mind documenting it.  A decent place to start from is:
"A list of the currently active `cl-block' forms.

Each element is of the form (NAME VAR FOUNDP) where NAME is the name of
the block as it is written in `cl-block' and `cl-return-from', VAR is
the tag as it is caught and thrown by `catch' and `throw', and FOUNDP is
non-nil if a `cl-return' or `cl-return-from' with the same name was
found.

This variable should be set such that the modifications can only be seen
within the same lexical scope."

bug#72279: FSF copyright assignment

[Thuna]

> Also I don't see you in the copyright file.  Would you like to do the
> FSF paperwork in order to be able to contribute non trivial patches to
> Emacs?

I have applied for an assignment a bit over two years ago now.
Unfortunately, the problem which stopped it from going through still
persists to date, namely that the university in which I am a student
(which is based in EU if that helps) refuses to sign the copyright
disclaimer - or more specifically that I cannot get a response from the
legal department to begin with.  Craig has previously reached out on my
behalf as well, but as far as I am aware they have similarly not had
much success.

The only way forward that I can see is a. do not consider them a
possibly claimant to my work an forgo the copyright disclaimer or
b. wait a year after which I will (hopefully) graduate and hope that the
university I go to for my post-grad is more open to communication.  I do
not believe that b. is bound to see much success, but I do also do not
know if a. is a viable option for the FSF.

bug#72279: [PATCH] Non-local exits from outside the lexical scope are caught by cl-block

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>   (defun foo () (cl-return "ruh roh"))
>   (cl-block nil (foo) (cl-return t)) ; => "ruh ruh"
>
> The first patch attached attempts to solve this by moving the
> functionality of the wrapper compiler macros to the macros themselves
> and by using uninterned symbols for the thrown and caught tags,
> communicated by the block to the corresponding returns.  All the
> existing tests seemed to run just fine but I did not do any
> comprehensive testing (and there doesn't appear to be any relevant
> suites either).

BTW, for the second patch a simpler solution is to expand

    (cl-block A FOO)
to
    (let ((cl--block--A ',(make-symbol "A")))
      (catch cl--block--A FOO))

and

    (cl-return B FOO)
to
    (throw cl--block--B FOO)

which will signal an "unknown variable cl--block--B" if a `cl-return` is
used outside of its block.

But the optimization of `cl-block` when the tag is not used is
important, so I don't think it's a good approach.

> I do take minor issue with `macroexpand-all'ing all things inside a
> block, making debugging via macrostep really annoying, but I don't know
> of a better solution, outside of communicating the tag during
> evaluation, which would look something like the second patch.

I think in theory it's possible to avoid the `macroexpand-all`, but it
requires a compiler-macro which (assuming we generate code like
I outlined above) will have to recognize those `(catch <VAR> ...)` where
the tag is not used anywhere else.

This is because compiler macros are executed by `macroexpand-all` both
before and after performing the normal macro expansions, so they do get
to see the code after `macroexpand-all`.  But it can be slightly tricky
to get it right and reliable (because it has to be careful to not mess
up the code if it hasn't been macroexpanded yet), and it has to walk the
whole code, which means that it needs to copy a fair bit of the code of
`macroexpand-all`.

> If it were to instead expand into a `catch' - whether because there is
> a `cl-return' or because `cl-block' is modified to always expandi into
> a `catch' as it is in my second patch - the setf will expand into
> (setf catch) which is not defined.

Yup, as I said, the "optimization" is important (most of the
`cl-block`s are implicit and unused, IME).

> I see two possible solutions, either define a (setf catch) or switch
> to defsubst instead of cl-defsubst.

I don't think we can implement a `setf catch` (tho we could probably
come up with a hack which works in practice for those
cl-defstruct slots).  🙁

IIRC for the slot accessors `defsubst` would lead to worse code than
what we currently get with `cl-defsubst` so it wouldn't be as good, but
I believe we could use `define-inline` instead.

AFAIC, your first patch looks good to me.


        Stefan

bug#72279: [PATCH] Non-local exits from outside the lexical scope are caught by cl-block

[Thuna]

> BTW, for the second patch a simpler solution is to expand
>
>     (cl-block A FOO)
> to
>     (let ((cl--block--A ',(make-symbol "A")))
>       (catch cl--block--A FOO))
>
> and
>
>     (cl-return B FOO)
> to
>     (throw cl--block--B FOO)
>
> which will signal an "unknown variable cl--block--B" if a `cl-return` is
> used outside of its block.

Aha, yes, that would indeed be simpler.

> But the optimization of `cl-block` when the tag is not used is
> important, so I don't think it's a good approach.

I don't have any particular complaints against keeping this
optimization, but for the record would you be able to expand on what
exactly the problem is?  It doesn't seem obvious to me that unused
`catch'es would make such a meaningful difference.

> Yup, as I said, the "optimization" is important (most of the
> `cl-block`s are implicit and unused, IME).

It would be nice if this would be documented at least in a comment above
`cl-block', even though it's unlikely that it will see too many changes.

>> I see two possible solutions, either define a (setf catch) or switch
>> to defsubst instead of cl-defsubst.
>
> I don't think we can implement a `setf catch` (tho we could probably
> come up with a hack which works in practice for those
> cl-defstruct slots).  🙁
>
> IIRC for the slot accessors `defsubst` would lead to worse code than
> what we currently get with `cl-defsubst` so it wouldn't be as good, but
> I believe we could use `define-inline` instead.

That sounds like a solution.  Defining a hack for `setf catch' seems
like it would lead to a lot of problems down the line, so it would be
better to put it off until someone comes up with a good way to do it
(though I doubt it is possible given dynamic exits).

bug#72279: [PATCH] Non-local exits from outside the lexical scope are caught by cl-block

[Andrea Corallo]

Thuna <thuna.cing@gmail.com> writes:

>> BTW, for the second patch a simpler solution is to expand
>>
>>     (cl-block A FOO)
>> to
>>     (let ((cl--block--A ',(make-symbol "A")))
>>       (catch cl--block--A FOO))
>>
>> and
>>
>>     (cl-return B FOO)
>> to
>>     (throw cl--block--B FOO)
>>
>> which will signal an "unknown variable cl--block--B" if a `cl-return` is
>> used outside of its block.
>
> Aha, yes, that would indeed be simpler.
>
>> But the optimization of `cl-block` when the tag is not used is
>> important, so I don't think it's a good approach.
>
> I don't have any particular complaints against keeping this
> optimization, but for the record would you be able to expand on what
> exactly the problem is?  It doesn't seem obvious to me that unused
> `catch'es would make such a meaningful difference.

Unused catches are a problem because they bloat bytecode unnecessary,
also they prevent a number of optimizations in the native compiler as
well.  Essentially every time you have a landing pad like a catch you
cannot make assumptions on where you are landing from and what's the
state of your machine.

It's very important we keep on removing unnecessary catches, that's why
I was asking in my previous mail.


  Andrea