all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#47677: [PATCH] condition-case success continuation
@ 2021-04-09 20:26 Mattias Engdegård
  2021-04-10 23:52 ` Stefan Monnier
  2021-04-26 21:57 ` Gregory Heytings
  0 siblings, 2 replies; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-09 20:26 UTC (permalink / raw)
  To: 47677

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

This patch adds the condition-case handler syntax

  (:success BODY)

for code executed when the protected form terminates without error. BODY is then executed with the variable bound to the result of the protected form, and the result of BODY is then the value of the condition-case form as usual.

This plugs an annoying hole in elisp: there hasn't been any direct access to the success continuation which forced programmers to resort to various hacks such as tagging the returned value and then immediately testing that tag, as in

(let ((input (condition-case _
                 (cons 'ok (read buffer))
               (end-of-file 'eof))))
  (when (consp input)
    (use (cdr input))))

Now we can write

(condition-case result
    (read buffer)
  (end-of-file 'eof)
  (:success (use result)))

which is more concise, elegant and performant.

Like all condition-case handlers (but in contrast to the protected form), the success handler is in the tail position and the limited self-tail-recursion of cl-labels (and named-let) works there as expected.

Details of the syntax can be changed if there is a very good reason for it. Many other languages have more or less independently added equivalent constructs. Common Lisp's `handler-case` has a very similar feature (:no-error).

It would be nice to give `catch` the same treatment. A particularly flexible solution would be to add `catch` handlers to `condition-case`, which would then be able to handle everything. Unless there is a strong reason for doing it right away, it can be seen as a later improvement.


[-- Attachment #2: 0001-Add-condition-case-success-handler.patch --]
[-- Type: application/octet-stream, Size: 13827 bytes --]

From 952fc7ea3878d3d71a82d669a1499aee0d1f8c55 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Wed, 7 Apr 2021 11:31:07 +0200
Subject: [PATCH] Add condition-case success handler

Allow a condition-case handler on the form (:success BODY) to be
specified as the success continuation of the protected form, with
the specified variable bound to its result.

* src/eval.c (Fcondition_case): Update the doc string.
(internal_lisp_condition_case): Implement in interpreter.
(syms_of_eval): Defsym :success.
* lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case):
Implement in byte-compiler.
* lisp/emacs-lisp/cl-macs.el (cl--self-tco): Allow self-TCO
from success handler.
* doc/lispref/control.texi (Handling Errors): Update manual.
* etc/NEWS: Announce.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases)
(bytecomp-condition-case-success):
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels):
Add test cases.
---
 doc/lispref/control.texi               |  9 ++-
 etc/NEWS                               |  5 ++
 lisp/emacs-lisp/bytecomp.el            | 28 ++++++++-
 lisp/emacs-lisp/cl-macs.el             |  4 +-
 src/eval.c                             | 34 ++++++++++-
 test/lisp/emacs-lisp/bytecomp-tests.el | 78 ++++++++++++++++++++++++++
 test/lisp/emacs-lisp/cl-macs-tests.el  |  9 +--
 7 files changed, 157 insertions(+), 10 deletions(-)

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 3388102f69..22b665bc93 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -2012,7 +2012,8 @@ Handling Errors
 This special form establishes the error handlers @var{handlers} around
 the execution of @var{protected-form}.  If @var{protected-form} executes
 without error, the value it returns becomes the value of the
-@code{condition-case} form; in this case, the @code{condition-case} has
+@code{condition-case} form (in the absence of a success handler; see below).
+In this case, the @code{condition-case} has
 no effect.  The @code{condition-case} form makes a difference when an
 error occurs during @var{protected-form}.
 
@@ -2062,6 +2063,12 @@ Handling Errors
 If @var{var} is @code{nil}, that means no variable is bound.  Then the
 error symbol and associated data are not available to the handler.
 
+@cindex success handler
+As a special case, one of the @var{handlers} can be a list of the
+form @code{(:success @var{body}@dots{})}, where @var{body} is executed
+with @var{var} (if non-@code{nil}) bound to the return value of
+@var{protected-form} when that expression terminates without error.
+
 @cindex rethrow a signal
 Sometimes it is necessary to re-throw a signal caught by
 @code{condition-case}, for some outer-level handler to catch.  Here's
diff --git a/etc/NEWS b/etc/NEWS
index a0f05d8cf1..fa82e2872f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2898,6 +2898,11 @@ arrays nor objects.
 The special events 'dbus-event' and 'file-notify' are now ignored in
 'while-no-input' when added to this variable.
 
++++
+** 'condition-case' now allows for a success handler.
+It is executed whenever the protected form terminates without error,
+with the specified variable bound to the returned value.
+
 \f
 * Changes in Emacs 28.1 on Non-Free Operating Systems
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0babbbb978..ce3a759487 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4621,10 +4621,15 @@ byte-compile-unwind-protect
 (defun byte-compile-condition-case (form)
   (let* ((var (nth 1 form))
          (body (nth 2 form))
+         (handlers (nthcdr 3 form))
          (depth byte-compile-depth)
+         (success-handler (assq :success handlers))
+         (failure-handlers (if success-handler
+                               (remq success-handler handlers)
+                             handlers))
          (clauses (mapcar (lambda (clause)
                             (cons (byte-compile-make-tag) clause))
-                          (nthcdr 3 form)))
+                          failure-handlers))
          (endtag (byte-compile-make-tag)))
     (byte-compile-set-symbol-position 'condition-case)
     (unless (symbolp var)
@@ -4650,6 +4655,27 @@ byte-compile-condition-case
 
     (byte-compile-form body) ;; byte-compile--for-effect
     (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
+
+    (when success-handler
+      (let ((success-body (cdr success-handler)))
+        (cond
+         ((null var)
+          (byte-compile-discard)
+          (byte-compile-body success-body byte-compile--for-effect))
+         (lexical-binding
+          (let ((byte-compile--lexical-environment
+                 byte-compile--lexical-environment))
+            (push (cons var (1- byte-compile-depth))
+                  byte-compile--lexical-environment)
+            (byte-compile-body success-body byte-compile--for-effect)
+            (byte-compile-discard 1 'preserve-tos)))
+         (t
+          (let ((byte-compile-bound-variables
+                 byte-compile-bound-variables))
+            (byte-compile-dynamic-variable-bind var)
+            (byte-compile-body success-body byte-compile--for-effect)
+            (byte-compile-out 'byte-unbind 1))))))
+
     (byte-compile-goto 'byte-goto endtag)
 
     (while clauses
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 68211ec410..b7e5be95bc 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2144,7 +2144,9 @@ cl--self-tco
             ((and `(condition-case ,err-var ,bodyform . ,handlers)
                   (guard (not (eq err-var var))))
              `(condition-case ,err-var
-                  (progn (setq ,retvar ,bodyform) nil)
+                  ,(if (assq :success handlers)
+                       bodyform
+                     `(progn (setq ,retvar ,bodyform) nil))
                 . ,(mapcar (lambda (h)
                              (cons (car h) (funcall opt-exps (cdr h))))
                            handlers)))
diff --git a/src/eval.c b/src/eval.c
index ddaa8edd81..41c4cd1637 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1301,7 +1301,7 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
        doc: /* Regain control when an error is signaled.
 Executes BODYFORM and returns its value if no error happens.
 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
-where the BODY is made of Lisp expressions.
+or (:success BODY), where the BODY is made of Lisp expressions.
 
 A handler is applicable to an error if CONDITION-NAME is one of the
 error's condition names.  Handlers may also apply when non-error
@@ -1323,6 +1323,10 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
 Then the value of the last BODY form is returned from the `condition-case'
 expression.
 
+The special handler (:success BODY) is invoked if BODYFORM terminated
+without signalling an error.  BODY is then evaluated with VAR bound to
+the value returned by BODYFORM.
+
 See also the function `signal' for more info.
 usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
   (Lisp_Object args)
@@ -1346,16 +1350,21 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 
   CHECK_SYMBOL (var);
 
+  Lisp_Object success_handler = Qnil;
+
   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
     {
       Lisp_Object tem = XCAR (tail);
-      clausenb++;
       if (! (NILP (tem)
 	     || (CONSP (tem)
 		 && (SYMBOLP (XCAR (tem))
 		     || CONSP (XCAR (tem))))))
 	error ("Invalid condition handler: %s",
 	       SDATA (Fprin1_to_string (tem, Qt)));
+      if (EQ (XCAR (tem), QCsuccess))
+	success_handler = XCDR (tem);
+      else
+	clausenb++;
     }
 
   /* The first clause is the one that should be checked first, so it
@@ -1369,7 +1378,8 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
   Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses);
   clauses += clausenb;
   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
-    *--clauses = XCAR (tail);
+    if (!EQ (XCAR (XCAR (tail)), QCsuccess))
+      *--clauses = XCAR (tail);
   for (ptrdiff_t i = 0; i < clausenb; i++)
     {
       Lisp_Object clause = clauses[i];
@@ -1409,6 +1419,23 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 
   Lisp_Object result = eval_sub (bodyform);
   handlerlist = oldhandlerlist;
+  if (!NILP (success_handler))
+    {
+      if (NILP (var))
+	return Fprogn (success_handler);
+
+      Lisp_Object handler_var = var;
+      if (!NILP (Vinternal_interpreter_environment))
+	{
+	  result = Fcons (Fcons (var, result),
+		       Vinternal_interpreter_environment);
+	  handler_var = Qinternal_interpreter_environment;
+	}
+
+      ptrdiff_t count = SPECPDL_INDEX ();
+      specbind (handler_var, result);
+      return unbind_to (count, Fprogn (success_handler));
+    }
   return result;
 }
 
@@ -4381,6 +4408,7 @@ syms_of_eval (void)
   defsubr (&Sthrow);
   defsubr (&Sunwind_protect);
   defsubr (&Scondition_case);
+  DEFSYM (QCsuccess, ":success");
   defsubr (&Ssignal);
   defsubr (&Scommandp);
   defsubr (&Sautoload);
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 94e33a7770..3ec443e04d 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -437,6 +437,42 @@ bytecomp-tests--test-cases
                   (/ 1 0)
                 (arith-error x))))
       (list x y))
+
+    ;; No error, no success handler.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x)))
+    ;; Error, no success handler.
+    (condition-case x
+        (/ 1 0)
+      (error (cons 'bad x)))
+    ;; No error, success handler.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x))
+      (:success (cons 'good x)))
+    ;; Error, success handler.
+    (condition-case x
+        (/ 1 0)
+      (error (cons 'bad x))
+      (:success (cons 'good x)))
+    ;; Verify that the success code is not subject to the error handlers.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x))
+      (:success (/ (car x) 0)))
+    ;; Check variable scoping on success.
+    (let ((x 2))
+      (condition-case x
+          (list x)
+        (error (list 'bad x))
+        (:success (list 'good x))))
+    ;; Check variable scoping on failure.
+    (let ((x 2))
+      (condition-case x
+          (/ 1 0)
+        (error (list 'bad x))
+        (:success (list 'good x))))
     )
   "List of expressions for cross-testing interpreted and compiled code.")
 
@@ -1178,6 +1214,48 @@ bytecomp-string-vs-docstring
   (let ((lexical-binding t))
     (should (equal (funcall (byte-compile '(lambda (x) "foo")) 'dummy) "foo"))))
 
+(ert-deftest bytecomp-condition-case-success ()
+  ;; No error, no success handler.
+  (should (equal (condition-case x
+                     (list 42)
+                   (error (cons 'bad x)))
+                 '(42)))
+  ;; Error, no success handler.
+  (should (equal (condition-case x
+                     (/ 1 0)
+                   (error (cons 'bad x)))
+                 '(bad arith-error)))
+  ;; No error, success handler.
+  (should (equal (condition-case x
+                     (list 42)
+                   (error (cons 'bad x))
+                   (:success (cons 'good x)))
+                 '(good 42)))
+  ;; Error, success handler.
+  (should (equal (condition-case x
+                     (/ 1 0)
+                   (error (cons 'bad x))
+                   (:success (cons 'good x)))
+                 '(bad arith-error)))
+  ;; Verify that the success code is not subject to the error handlers.
+  (should-error (condition-case x
+                    (list 42)
+                  (error (cons 'bad x))
+                  (:success (/ (car x) 0)))
+                :type 'arith-error)
+  ;; Check variable scoping.
+  (let ((x 2))
+    (should (equal (condition-case x
+                       (list x)
+                     (error (list 'bad x))
+                     (:success (list 'good x)))
+                   '(good (2))))
+    (should (equal (condition-case x
+                       (/ 1 0)
+                     (error (list 'bad x))
+                     (:success (list 'good x)))
+                   '(bad (arith-error))))))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 5c3e603b92..f4e2e46a01 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -630,12 +630,13 @@ cl-macs--labels
                             (and xs
                                  (progn (setq n1 (1+ n))
                                         (len2 (cdr xs) n1))))))
-         ;; Tail call in error handler.
+         ;; Tail calls in error and success handlers.
          (len3 (xs n)
                (if xs
-                   (condition-case nil
-                       (/ 1 0)
-                     (arith-error (len3 (cdr xs) (1+ n))))
+                   (condition-case k
+                       (/ 1 (logand n 1))
+                     (arith-error (len3 (cdr xs) (1+ n)))
+                     (:success (len3 (cdr xs) (+ n k))))
                  n)))
       (should (equal (len nil 0) 0))
       (should (equal (len2 nil 0) 0))
-- 
2.21.1 (Apple Git-122.3)


^ permalink raw reply related	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-09 20:26 bug#47677: [PATCH] condition-case success continuation Mattias Engdegård
@ 2021-04-10 23:52 ` Stefan Monnier
  2021-04-11 11:13   ` Mattias Engdegård
  2021-04-26 21:57 ` Gregory Heytings
  1 sibling, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2021-04-10 23:52 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: 47677

> This patch adds the condition-case handler syntax
>
>   (:success BODY)

In the tests, you might want to add one with a lambda expression which
captures a mutated success variable, as in

    (apply (condition-case res
               42
             (:success (prog1 (list (lambda (x) (+ res x)) res)
                         (setq res 0)))))

since this requires special handling in cconv.el.
Other than that, the patch looks good to me.

> Details of the syntax can be changed if there is a very good reason
> for it. Many other languages have more or less independently added
> equivalent constructs. Common Lisp's `handler-case` has a very similar
> feature (:no-error).

Any particular reason you chose ;success instead of :no-error?

> It would be nice to give `catch` the same treatment. A particularly
> flexible solution would be to add `catch` handlers to
> `condition-case`, which would then be able to handle
> everything. Unless there is a strong reason for doing it right away,
> it can be seen as a later improvement.

Let's take it one step at a time.


        Stefan






^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-10 23:52 ` Stefan Monnier
@ 2021-04-11 11:13   ` Mattias Engdegård
  2021-04-12  8:49     ` Lars Ingebrigtsen
  0 siblings, 1 reply; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-11 11:13 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: 47677

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

11 apr. 2021 kl. 01.52 skrev Stefan Monnier <monnier@iro.umontreal.ca>:

> In the tests, you might want to add one with a lambda expression which
> captures a mutated success variable, as in
> 
>    (apply (condition-case res
>               42
>             (:success (prog1 (list (lambda (x) (+ res x)) res)
>                         (setq res 0)))))
> 
> since this requires special handling in cconv.el.

Good catch! Fixed on master. (And I've added more test cases to the patch.)

> Any particular reason you chose ;success instead of :no-error?

Only a few weak reasons -- some conditions (like quit) aren't errors, although the documentation is very inconsistent on that point. And :success felt slightly more descriptive, and it doesn't have a negation in the name.

Names like :default, :else, :otherwise etc were rejected because they could be interpreted as 'any other error'.

It may be a bit too far over the moon though. Would :not-a-complete-failure be better? Fits my gloomy national temperaments (all of them) better.

Still undecided!


[-- Attachment #2: 0001-Add-condition-case-success-handler-bug-47677.patch --]
[-- Type: application/octet-stream, Size: 14345 bytes --]

From dcb8b351116e1785aa5395c3d3ffefd836cac4b4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Wed, 7 Apr 2021 11:31:07 +0200
Subject: [PATCH] Add condition-case success handler (bug#47677)

Allow a condition-case handler on the form (:success BODY) to be
specified as the success continuation of the protected form, with
the specified variable bound to its result.

* src/eval.c (Fcondition_case): Update the doc string.
(internal_lisp_condition_case): Implement in interpreter.
(syms_of_eval): Defsym :success.
* lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case):
Implement in byte-compiler.
* lisp/emacs-lisp/cl-macs.el (cl--self-tco): Allow self-TCO
from success handler.
* doc/lispref/control.texi (Handling Errors): Update manual.
* etc/NEWS: Announce.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases)
(bytecomp-condition-case-success):
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels):
Add test cases.
---
 doc/lispref/control.texi               |  9 ++-
 etc/NEWS                               |  5 ++
 lisp/emacs-lisp/bytecomp.el            | 28 +++++++-
 lisp/emacs-lisp/cl-macs.el             |  4 +-
 src/eval.c                             | 34 +++++++++-
 test/lisp/emacs-lisp/bytecomp-tests.el | 93 ++++++++++++++++++++++++++
 test/lisp/emacs-lisp/cl-macs-tests.el  |  9 +--
 7 files changed, 172 insertions(+), 10 deletions(-)

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 3388102f69..22b665bc93 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -2012,7 +2012,8 @@ Handling Errors
 This special form establishes the error handlers @var{handlers} around
 the execution of @var{protected-form}.  If @var{protected-form} executes
 without error, the value it returns becomes the value of the
-@code{condition-case} form; in this case, the @code{condition-case} has
+@code{condition-case} form (in the absence of a success handler; see below).
+In this case, the @code{condition-case} has
 no effect.  The @code{condition-case} form makes a difference when an
 error occurs during @var{protected-form}.
 
@@ -2062,6 +2063,12 @@ Handling Errors
 If @var{var} is @code{nil}, that means no variable is bound.  Then the
 error symbol and associated data are not available to the handler.
 
+@cindex success handler
+As a special case, one of the @var{handlers} can be a list of the
+form @code{(:success @var{body}@dots{})}, where @var{body} is executed
+with @var{var} (if non-@code{nil}) bound to the return value of
+@var{protected-form} when that expression terminates without error.
+
 @cindex rethrow a signal
 Sometimes it is necessary to re-throw a signal caught by
 @code{condition-case}, for some outer-level handler to catch.  Here's
diff --git a/etc/NEWS b/etc/NEWS
index aaf38022c5..74d8ad0da7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2922,6 +2922,11 @@ arrays nor objects.
 The special events 'dbus-event' and 'file-notify' are now ignored in
 'while-no-input' when added to this variable.
 
++++
+** 'condition-case' now allows for a success handler.
+It is executed whenever the protected form terminates without error,
+with the specified variable bound to the returned value.
+
 \f
 * Changes in Emacs 28.1 on Non-Free Operating Systems
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0babbbb978..ce3a759487 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4621,10 +4621,15 @@ byte-compile-unwind-protect
 (defun byte-compile-condition-case (form)
   (let* ((var (nth 1 form))
          (body (nth 2 form))
+         (handlers (nthcdr 3 form))
          (depth byte-compile-depth)
+         (success-handler (assq :success handlers))
+         (failure-handlers (if success-handler
+                               (remq success-handler handlers)
+                             handlers))
          (clauses (mapcar (lambda (clause)
                             (cons (byte-compile-make-tag) clause))
-                          (nthcdr 3 form)))
+                          failure-handlers))
          (endtag (byte-compile-make-tag)))
     (byte-compile-set-symbol-position 'condition-case)
     (unless (symbolp var)
@@ -4650,6 +4655,27 @@ byte-compile-condition-case
 
     (byte-compile-form body) ;; byte-compile--for-effect
     (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
+
+    (when success-handler
+      (let ((success-body (cdr success-handler)))
+        (cond
+         ((null var)
+          (byte-compile-discard)
+          (byte-compile-body success-body byte-compile--for-effect))
+         (lexical-binding
+          (let ((byte-compile--lexical-environment
+                 byte-compile--lexical-environment))
+            (push (cons var (1- byte-compile-depth))
+                  byte-compile--lexical-environment)
+            (byte-compile-body success-body byte-compile--for-effect)
+            (byte-compile-discard 1 'preserve-tos)))
+         (t
+          (let ((byte-compile-bound-variables
+                 byte-compile-bound-variables))
+            (byte-compile-dynamic-variable-bind var)
+            (byte-compile-body success-body byte-compile--for-effect)
+            (byte-compile-out 'byte-unbind 1))))))
+
     (byte-compile-goto 'byte-goto endtag)
 
     (while clauses
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 68211ec410..b7e5be95bc 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2144,7 +2144,9 @@ cl--self-tco
             ((and `(condition-case ,err-var ,bodyform . ,handlers)
                   (guard (not (eq err-var var))))
              `(condition-case ,err-var
-                  (progn (setq ,retvar ,bodyform) nil)
+                  ,(if (assq :success handlers)
+                       bodyform
+                     `(progn (setq ,retvar ,bodyform) nil))
                 . ,(mapcar (lambda (h)
                              (cons (car h) (funcall opt-exps (cdr h))))
                            handlers)))
diff --git a/src/eval.c b/src/eval.c
index ddaa8edd81..41c4cd1637 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1301,7 +1301,7 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
        doc: /* Regain control when an error is signaled.
 Executes BODYFORM and returns its value if no error happens.
 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
-where the BODY is made of Lisp expressions.
+or (:success BODY), where the BODY is made of Lisp expressions.
 
 A handler is applicable to an error if CONDITION-NAME is one of the
 error's condition names.  Handlers may also apply when non-error
@@ -1323,6 +1323,10 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
 Then the value of the last BODY form is returned from the `condition-case'
 expression.
 
+The special handler (:success BODY) is invoked if BODYFORM terminated
+without signalling an error.  BODY is then evaluated with VAR bound to
+the value returned by BODYFORM.
+
 See also the function `signal' for more info.
 usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
   (Lisp_Object args)
@@ -1346,16 +1350,21 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 
   CHECK_SYMBOL (var);
 
+  Lisp_Object success_handler = Qnil;
+
   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
     {
       Lisp_Object tem = XCAR (tail);
-      clausenb++;
       if (! (NILP (tem)
 	     || (CONSP (tem)
 		 && (SYMBOLP (XCAR (tem))
 		     || CONSP (XCAR (tem))))))
 	error ("Invalid condition handler: %s",
 	       SDATA (Fprin1_to_string (tem, Qt)));
+      if (EQ (XCAR (tem), QCsuccess))
+	success_handler = XCDR (tem);
+      else
+	clausenb++;
     }
 
   /* The first clause is the one that should be checked first, so it
@@ -1369,7 +1378,8 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
   Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses);
   clauses += clausenb;
   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
-    *--clauses = XCAR (tail);
+    if (!EQ (XCAR (XCAR (tail)), QCsuccess))
+      *--clauses = XCAR (tail);
   for (ptrdiff_t i = 0; i < clausenb; i++)
     {
       Lisp_Object clause = clauses[i];
@@ -1409,6 +1419,23 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 
   Lisp_Object result = eval_sub (bodyform);
   handlerlist = oldhandlerlist;
+  if (!NILP (success_handler))
+    {
+      if (NILP (var))
+	return Fprogn (success_handler);
+
+      Lisp_Object handler_var = var;
+      if (!NILP (Vinternal_interpreter_environment))
+	{
+	  result = Fcons (Fcons (var, result),
+		       Vinternal_interpreter_environment);
+	  handler_var = Qinternal_interpreter_environment;
+	}
+
+      ptrdiff_t count = SPECPDL_INDEX ();
+      specbind (handler_var, result);
+      return unbind_to (count, Fprogn (success_handler));
+    }
   return result;
 }
 
@@ -4381,6 +4408,7 @@ syms_of_eval (void)
   defsubr (&Sthrow);
   defsubr (&Sunwind_protect);
   defsubr (&Scondition_case);
+  DEFSYM (QCsuccess, ":success");
   defsubr (&Ssignal);
   defsubr (&Scommandp);
   defsubr (&Sautoload);
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index a11832d805..69543320a7 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -444,6 +444,49 @@ bytecomp-tests--test-cases
        (arith-error (prog1 (lambda (y) (+ y x))
                       (setq x 10))))
      4)
+
+    ;; No error, no success handler.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x)))
+    ;; Error, no success handler.
+    (condition-case x
+        (/ 1 0)
+      (error (cons 'bad x)))
+    ;; No error, success handler.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x))
+      (:success (cons 'good x)))
+    ;; Error, success handler.
+    (condition-case x
+        (/ 1 0)
+      (error (cons 'bad x))
+      (:success (cons 'good x)))
+    ;; Verify that the success code is not subject to the error handlers.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x))
+      (:success (/ (car x) 0)))
+    ;; Check variable scoping on success.
+    (let ((x 2))
+      (condition-case x
+          (list x)
+        (error (list 'bad x))
+        (:success (list 'good x))))
+    ;; Check variable scoping on failure.
+    (let ((x 2))
+      (condition-case x
+          (/ 1 0)
+        (error (list 'bad x))
+        (:success (list 'good x))))
+    ;; Check capture of mutated result variable.
+    (funcall
+     (condition-case x
+         3
+       (:success (prog1 (lambda (y) (+ y x))
+                   (setq x 10))))
+     4)
     )
   "List of expressions for cross-testing interpreted and compiled code.")
 
@@ -1185,6 +1228,56 @@ bytecomp-string-vs-docstring
   (let ((lexical-binding t))
     (should (equal (funcall (byte-compile '(lambda (x) "foo")) 'dummy) "foo"))))
 
+(ert-deftest bytecomp-condition-case-success ()
+  ;; No error, no success handler.
+  (should (equal (condition-case x
+                     (list 42)
+                   (error (cons 'bad x)))
+                 '(42)))
+  ;; Error, no success handler.
+  (should (equal (condition-case x
+                     (/ 1 0)
+                   (error (cons 'bad x)))
+                 '(bad arith-error)))
+  ;; No error, success handler.
+  (should (equal (condition-case x
+                     (list 42)
+                   (error (cons 'bad x))
+                   (:success (cons 'good x)))
+                 '(good 42)))
+  ;; Error, success handler.
+  (should (equal (condition-case x
+                     (/ 1 0)
+                   (error (cons 'bad x))
+                   (:success (cons 'good x)))
+                 '(bad arith-error)))
+  ;; Verify that the success code is not subject to the error handlers.
+  (should-error (condition-case x
+                    (list 42)
+                  (error (cons 'bad x))
+                  (:success (/ (car x) 0)))
+                :type 'arith-error)
+  ;; Check variable scoping.
+  (let ((x 2))
+    (should (equal (condition-case x
+                       (list x)
+                     (error (list 'bad x))
+                     (:success (list 'good x)))
+                   '(good (2))))
+    (should (equal (condition-case x
+                       (/ 1 0)
+                     (error (list 'bad x))
+                     (:success (list 'good x)))
+                   '(bad (arith-error)))))
+  ;; Check capture of mutated result variable.
+  (should (equal (funcall
+                  (condition-case x
+                      3
+                    (:success (prog1 (lambda (y) (+ y x))
+                                (setq x 10))))
+                  4)
+                 14)))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 5c3e603b92..f4e2e46a01 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -630,12 +630,13 @@ cl-macs--labels
                             (and xs
                                  (progn (setq n1 (1+ n))
                                         (len2 (cdr xs) n1))))))
-         ;; Tail call in error handler.
+         ;; Tail calls in error and success handlers.
          (len3 (xs n)
                (if xs
-                   (condition-case nil
-                       (/ 1 0)
-                     (arith-error (len3 (cdr xs) (1+ n))))
+                   (condition-case k
+                       (/ 1 (logand n 1))
+                     (arith-error (len3 (cdr xs) (1+ n)))
+                     (:success (len3 (cdr xs) (+ n k))))
                  n)))
       (should (equal (len nil 0) 0))
       (should (equal (len2 nil 0) 0))
-- 
2.21.1 (Apple Git-122.3)


^ permalink raw reply related	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-11 11:13   ` Mattias Engdegård
@ 2021-04-12  8:49     ` Lars Ingebrigtsen
  2021-04-12 15:10       ` Stefan Monnier
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Ingebrigtsen @ 2021-04-12  8:49 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: Stefan Monnier, 47677

Mattias Engdegård <mattiase@acm.org> writes:

> It may be a bit too far over the moon though. Would
> :not-a-complete-failure be better? Fits my gloomy national
> temperaments (all of them) better.

:-)

I like :success here.  Let's bring some positivity.  And I also like
the feature -- you sometimes see people doing

(condition-case
  (progn
    (something-that-may-fail)
    (setq didnt-fail t))
  (error ...))
(when didnt-fail
  ...)

and this would be much nicer.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-12  8:49     ` Lars Ingebrigtsen
@ 2021-04-12 15:10       ` Stefan Monnier
  2021-04-12 19:20         ` Mattias Engdegård
  0 siblings, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2021-04-12 15:10 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: Mattias Engdegård, 47677

>> It may be a bit too far over the moon though. Would
>> :not-a-complete-failure be better? Fits my gloomy national
>> temperaments (all of them) better.
>
> :-)
>
> I like :success here.  Let's bring some positivity.  And I also like
> the feature -- you sometimes see people doing
>
> (condition-case
>   (progn
>     (something-that-may-fail)
>     (setq didnt-fail t))
>   (error ...))
> (when didnt-fail
>   ...)
>
> and this would be much nicer.

Indeed, a nice sidekick to Mattias's patch would be another patch which
rewrites some of those condition-cases.  I know I wrote some of those
but somehow can't remember where, nor can I think of a good way to grep
for them.


        Stefan






^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-12 15:10       ` Stefan Monnier
@ 2021-04-12 19:20         ` Mattias Engdegård
  2021-04-13  7:38           ` Lars Ingebrigtsen
  0 siblings, 1 reply; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-12 19:20 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: Lars Ingebrigtsen, 47677

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

Here is an updated patch that reduces some code duplication in the compiler and fixes an embarrassing bug, and as a bonus, an experimental add-on that allows catching throws in condition-case using the handler syntax

  ((:catch TAG) BODY...)

Unfortunately but unsurprisingly the decision to evaluate the TAG expressions made everything much messier than anticipated. It does work, though, and if you would like to redefine `catch` as the macro

(defmacro catch (tag &rest body)
  (let ((var (gensym)))
    `(condition-case ,var (progn ,@body) ((:catch ,tag) ,var))))

then that will work, too (with minor byte-code inefficiency that could easily be addressed).
Any combination of error, :catch and :success handlers is permitted, making this a very versatile construct.

It may be a good idea to do away with the TAG evaluation since that flexibility isn't likely to be in high demand.


[-- Attachment #2: 0001-Add-condition-case-success-handler-bug-47677.patch --]
[-- Type: application/octet-stream, Size: 17120 bytes --]

From 864e56e63b45a05cb7ff274f33a2b4c9ee45746e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Wed, 7 Apr 2021 11:31:07 +0200
Subject: [PATCH] Add condition-case success handler (bug#47677)

Allow a condition-case handler on the form (:success BODY) to be
specified as the success continuation of the protected form, with
the specified variable bound to its result.

* src/eval.c (Fcondition_case): Update the doc string.
(internal_lisp_condition_case): Implement in interpreter.
(syms_of_eval): Defsym :success.
* lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case):
Implement in byte-compiler.
* lisp/emacs-lisp/cl-macs.el (cl--self-tco): Allow self-TCO
from success handler.
* doc/lispref/control.texi (Handling Errors): Update manual.
* etc/NEWS: Announce.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases)
(bytecomp-condition-case-success):
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels):
Add test cases.
---
 doc/lispref/control.texi               |   9 +-
 etc/NEWS                               |   5 +
 lisp/emacs-lisp/bytecomp.el            |  63 +++++++-----
 lisp/emacs-lisp/cl-macs.el             |   4 +-
 src/eval.c                             |  34 ++++++-
 test/lisp/emacs-lisp/bytecomp-tests.el | 127 +++++++++++++++++++++++++
 test/lisp/emacs-lisp/cl-macs-tests.el  |   9 +-
 7 files changed, 218 insertions(+), 33 deletions(-)

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 3388102f69..22b665bc93 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -2012,7 +2012,8 @@ Handling Errors
 This special form establishes the error handlers @var{handlers} around
 the execution of @var{protected-form}.  If @var{protected-form} executes
 without error, the value it returns becomes the value of the
-@code{condition-case} form; in this case, the @code{condition-case} has
+@code{condition-case} form (in the absence of a success handler; see below).
+In this case, the @code{condition-case} has
 no effect.  The @code{condition-case} form makes a difference when an
 error occurs during @var{protected-form}.
 
@@ -2062,6 +2063,12 @@ Handling Errors
 If @var{var} is @code{nil}, that means no variable is bound.  Then the
 error symbol and associated data are not available to the handler.
 
+@cindex success handler
+As a special case, one of the @var{handlers} can be a list of the
+form @code{(:success @var{body}@dots{})}, where @var{body} is executed
+with @var{var} (if non-@code{nil}) bound to the return value of
+@var{protected-form} when that expression terminates without error.
+
 @cindex rethrow a signal
 Sometimes it is necessary to re-throw a signal caught by
 @code{condition-case}, for some outer-level handler to catch.  Here's
diff --git a/etc/NEWS b/etc/NEWS
index 7483a6e5b7..4ce33f06f0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2922,6 +2922,11 @@ arrays nor objects.
 The special events 'dbus-event' and 'file-notify' are now ignored in
 'while-no-input' when added to this variable.
 
++++
+** 'condition-case' now allows for a success handler.
+It is executed whenever the protected form terminates without error,
+with the specified variable bound to the returned value.
+
 \f
 * Changes in Emacs 28.1 on Non-Free Operating Systems
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0babbbb978..4f91f0d5de 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4621,10 +4621,15 @@ byte-compile-unwind-protect
 (defun byte-compile-condition-case (form)
   (let* ((var (nth 1 form))
          (body (nth 2 form))
+         (handlers (nthcdr 3 form))
          (depth byte-compile-depth)
+         (success-handler (assq :success handlers))
+         (failure-handlers (if success-handler
+                               (remq success-handler handlers)
+                             handlers))
          (clauses (mapcar (lambda (clause)
                             (cons (byte-compile-make-tag) clause))
-                          (nthcdr 3 form)))
+                          failure-handlers))
          (endtag (byte-compile-make-tag)))
     (byte-compile-set-symbol-position 'condition-case)
     (unless (symbolp var)
@@ -4650,30 +4655,40 @@ byte-compile-condition-case
 
     (byte-compile-form body) ;; byte-compile--for-effect
     (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
-    (byte-compile-goto 'byte-goto endtag)
 
-    (while clauses
-      (let ((clause (pop clauses))
-            (byte-compile-bound-variables byte-compile-bound-variables)
-            (byte-compile--lexical-environment
-             byte-compile--lexical-environment))
-        (setq byte-compile-depth (1+ depth))
-        (byte-compile-out-tag (pop clause))
-        (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
-        (cond
-         ((null var) (byte-compile-discard))
-         (lexical-binding
-          (push (cons var (1- byte-compile-depth))
-                byte-compile--lexical-environment))
-         (t (byte-compile-dynamic-variable-bind var)))
-        (byte-compile-body (cdr clause)) ;; byte-compile--for-effect
-        (cond
-         ((null var) nil)
-         (lexical-binding (byte-compile-discard 1 'preserve-tos))
-         (t (byte-compile-out 'byte-unbind 1)))
-        (byte-compile-goto 'byte-goto endtag)))
-
-    (byte-compile-out-tag endtag)))
+    (let ((compile-handler-body
+           (lambda (body)
+             (let ((byte-compile-bound-variables byte-compile-bound-variables)
+                   (byte-compile--lexical-environment
+                    byte-compile--lexical-environment))
+               (cond
+                ((null var) (byte-compile-discard))
+                (lexical-binding
+                 (push (cons var (1- byte-compile-depth))
+                       byte-compile--lexical-environment))
+                (t (byte-compile-dynamic-variable-bind var)))
+
+               (byte-compile-body body) ;; byte-compile--for-effect
+
+               (cond
+                ((null var))
+                (lexical-binding (byte-compile-discard 1 'preserve-tos))
+                (t (byte-compile-out 'byte-unbind 1)))))))
+
+      (when success-handler
+        (funcall compile-handler-body (cdr success-handler)))
+
+      (byte-compile-goto 'byte-goto endtag)
+
+      (while clauses
+        (let ((clause (pop clauses)))
+          (setq byte-compile-depth (1+ depth))
+          (byte-compile-out-tag (pop clause))
+          (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
+          (funcall compile-handler-body (cdr clause))
+          (byte-compile-goto 'byte-goto endtag)))
+
+      (byte-compile-out-tag endtag))))
 
 (defun byte-compile-save-excursion (form)
   (if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 68211ec410..b7e5be95bc 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2144,7 +2144,9 @@ cl--self-tco
             ((and `(condition-case ,err-var ,bodyform . ,handlers)
                   (guard (not (eq err-var var))))
              `(condition-case ,err-var
-                  (progn (setq ,retvar ,bodyform) nil)
+                  ,(if (assq :success handlers)
+                       bodyform
+                     `(progn (setq ,retvar ,bodyform) nil))
                 . ,(mapcar (lambda (h)
                              (cons (car h) (funcall opt-exps (cdr h))))
                            handlers)))
diff --git a/src/eval.c b/src/eval.c
index ddaa8edd81..fd93f5b9e1 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1301,7 +1301,7 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
        doc: /* Regain control when an error is signaled.
 Executes BODYFORM and returns its value if no error happens.
 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
-where the BODY is made of Lisp expressions.
+or (:success BODY...), where the BODY is made of Lisp expressions.
 
 A handler is applicable to an error if CONDITION-NAME is one of the
 error's condition names.  Handlers may also apply when non-error
@@ -1323,6 +1323,10 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
 Then the value of the last BODY form is returned from the `condition-case'
 expression.
 
+The special handler (:success BODY...) is invoked if BODYFORM terminated
+without signalling an error.  BODY is then evaluated with VAR bound to
+the value returned by BODYFORM.
+
 See also the function `signal' for more info.
 usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
   (Lisp_Object args)
@@ -1346,16 +1350,21 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 
   CHECK_SYMBOL (var);
 
+  Lisp_Object success_handler = Qnil;
+
   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
     {
       Lisp_Object tem = XCAR (tail);
-      clausenb++;
       if (! (NILP (tem)
 	     || (CONSP (tem)
 		 && (SYMBOLP (XCAR (tem))
 		     || CONSP (XCAR (tem))))))
 	error ("Invalid condition handler: %s",
 	       SDATA (Fprin1_to_string (tem, Qt)));
+      if (EQ (XCAR (tem), QCsuccess))
+	success_handler = XCDR (tem);
+      else
+	clausenb++;
     }
 
   /* The first clause is the one that should be checked first, so it
@@ -1369,7 +1378,8 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
   Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses);
   clauses += clausenb;
   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
-    *--clauses = XCAR (tail);
+    if (!EQ (XCAR (XCAR (tail)), QCsuccess))
+      *--clauses = XCAR (tail);
   for (ptrdiff_t i = 0; i < clausenb; i++)
     {
       Lisp_Object clause = clauses[i];
@@ -1409,6 +1419,23 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 
   Lisp_Object result = eval_sub (bodyform);
   handlerlist = oldhandlerlist;
+  if (!NILP (success_handler))
+    {
+      if (NILP (var))
+	return Fprogn (success_handler);
+
+      Lisp_Object handler_var = var;
+      if (!NILP (Vinternal_interpreter_environment))
+	{
+	  result = Fcons (Fcons (var, result),
+		       Vinternal_interpreter_environment);
+	  handler_var = Qinternal_interpreter_environment;
+	}
+
+      ptrdiff_t count = SPECPDL_INDEX ();
+      specbind (handler_var, result);
+      return unbind_to (count, Fprogn (success_handler));
+    }
   return result;
 }
 
@@ -4381,6 +4408,7 @@ syms_of_eval (void)
   defsubr (&Sthrow);
   defsubr (&Sunwind_protect);
   defsubr (&Scondition_case);
+  DEFSYM (QCsuccess, ":success");
   defsubr (&Ssignal);
   defsubr (&Scommandp);
   defsubr (&Sautoload);
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index a11832d805..c9ab3ec1f1 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -444,6 +444,65 @@ bytecomp-tests--test-cases
        (arith-error (prog1 (lambda (y) (+ y x))
                       (setq x 10))))
      4)
+
+    ;; No error, no success handler.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x)))
+    ;; Error, no success handler.
+    (condition-case x
+        (/ 1 0)
+      (error (cons 'bad x)))
+    ;; No error, success handler.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x))
+      (:success (cons 'good x)))
+    ;; Error, success handler.
+    (condition-case x
+        (/ 1 0)
+      (error (cons 'bad x))
+      (:success (cons 'good x)))
+    ;; Verify that the success code is not subject to the error handlers.
+    (condition-case x
+        (list 42)
+      (error (cons 'bad x))
+      (:success (/ (car x) 0)))
+    ;; Check variable scoping on success.
+    (let ((x 2))
+      (condition-case x
+          (list x)
+        (error (list 'bad x))
+        (:success (list 'good x))))
+    ;; Check variable scoping on failure.
+    (let ((x 2))
+      (condition-case x
+          (/ 1 0)
+        (error (list 'bad x))
+        (:success (list 'good x))))
+    ;; Check capture of mutated result variable.
+    (funcall
+     (condition-case x
+         3
+       (:success (prog1 (lambda (y) (+ y x))
+                   (setq x 10))))
+     4)
+    ;; Check for-effect context, on error.
+    (let ((f (lambda (x)
+               (condition-case nil
+                   (/ 1 0)
+                 (error 'bad)
+                 (:success 'good))
+               (1+ x))))
+      (funcall f 3))
+    ;; Check for-effect context, on success.
+    (let ((f (lambda (x)
+               (condition-case nil
+                   nil
+                 (error 'bad)
+                 (:success 'good))
+               (1+ x))))
+      (funcall f 3))
     )
   "List of expressions for cross-testing interpreted and compiled code.")
 
@@ -1185,6 +1244,74 @@ bytecomp-string-vs-docstring
   (let ((lexical-binding t))
     (should (equal (funcall (byte-compile '(lambda (x) "foo")) 'dummy) "foo"))))
 
+(ert-deftest bytecomp-condition-case-success ()
+  ;; No error, no success handler.
+  (should (equal (condition-case x
+                     (list 42)
+                   (error (cons 'bad x)))
+                 '(42)))
+  ;; Error, no success handler.
+  (should (equal (condition-case x
+                     (/ 1 0)
+                   (error (cons 'bad x)))
+                 '(bad arith-error)))
+  ;; No error, success handler.
+  (should (equal (condition-case x
+                     (list 42)
+                   (error (cons 'bad x))
+                   (:success (cons 'good x)))
+                 '(good 42)))
+  ;; Error, success handler.
+  (should (equal (condition-case x
+                     (/ 1 0)
+                   (error (cons 'bad x))
+                   (:success (cons 'good x)))
+                 '(bad arith-error)))
+  ;; Verify that the success code is not subject to the error handlers.
+  (should-error (condition-case x
+                    (list 42)
+                  (error (cons 'bad x))
+                  (:success (/ (car x) 0)))
+                :type 'arith-error)
+  ;; Check variable scoping.
+  (let ((x 2))
+    (should (equal (condition-case x
+                       (list x)
+                     (error (list 'bad x))
+                     (:success (list 'good x)))
+                   '(good (2))))
+    (should (equal (condition-case x
+                       (/ 1 0)
+                     (error (list 'bad x))
+                     (:success (list 'good x)))
+                   '(bad (arith-error)))))
+  ;; Check capture of mutated result variable.
+  (should (equal (funcall
+                  (condition-case x
+                      3
+                    (:success (prog1 (lambda (y) (+ y x))
+                                (setq x 10))))
+                  4)
+                 14))
+    ;; Check for-effect context, on error.
+  (should (equal (let ((f (lambda (x)
+                            (condition-case nil
+                                (/ 1 0)
+                              (error 'bad)
+                              (:success 'good))
+                            (1+ x))))
+                   (funcall f 3))
+                 4))
+  ;; Check for-effect context, on success.
+  (should (equal (let ((f (lambda (x)
+                            (condition-case nil
+                                nil
+                              (error 'bad)
+                              (:success 'good))
+                            (1+ x))))
+                   (funcall f 3))
+                 4)))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 5c3e603b92..f4e2e46a01 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -630,12 +630,13 @@ cl-macs--labels
                             (and xs
                                  (progn (setq n1 (1+ n))
                                         (len2 (cdr xs) n1))))))
-         ;; Tail call in error handler.
+         ;; Tail calls in error and success handlers.
          (len3 (xs n)
                (if xs
-                   (condition-case nil
-                       (/ 1 0)
-                     (arith-error (len3 (cdr xs) (1+ n))))
+                   (condition-case k
+                       (/ 1 (logand n 1))
+                     (arith-error (len3 (cdr xs) (1+ n)))
+                     (:success (len3 (cdr xs) (+ n k))))
                  n)))
       (should (equal (len nil 0) 0))
       (should (equal (len2 nil 0) 0))
-- 
2.21.1 (Apple Git-122.3)


[-- Attachment #3: catch-in-condition-case.diff --]
[-- Type: application/octet-stream, Size: 10325 bytes --]

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 4f91f0d5de..82e0edd772 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4636,22 +4636,34 @@ byte-compile-condition-case
       (byte-compile-warn
        "`%s' is not a variable-name or nil (in condition-case)" var))
 
-    (dolist (clause (reverse clauses))
-      (let ((condition (nth 1 clause)))
-        (unless (consp condition) (setq condition (list condition)))
-        (dolist (c condition)
-          (unless (and c (symbolp c))
-            (byte-compile-warn
-             "`%S' is not a condition name (in condition-case)" c))
-          ;; In reality, the `error-conditions' property is only required
-          ;; for the argument to `signal', not to `condition-case'.
-          ;;(unless (consp (get c 'error-conditions))
-          ;;  (byte-compile-warn
-          ;;   "`%s' is not a known condition name (in condition-case)"
-          ;;   c))
-          )
-        (byte-compile-push-constant condition))
-      (byte-compile-goto 'byte-pushconditioncase (car clause)))
+    (let ((initial-depth byte-compile-depth)
+          (push-ops nil))
+      ;; Push all conditions and tags in left-to-right order first,
+      ;; since tags need to be evaluated outside the scope of the handlers.
+      (dolist (clause clauses)
+        (let ((condition (nth 1 clause)))
+          (pcase condition
+            (`(:catch ,tag-expr)
+             (byte-compile-form tag-expr)
+             (push (cons 'byte-pushcatch (car clause)) push-ops))
+            (`(:catch . ,_)
+             (error "malformed :catch clause: `%S'" (cdr clause)))
+            (_             ; error clause
+             (unless (consp condition)
+               (setq condition (list condition)))
+             (dolist (c condition)
+               (unless (and c (symbolp c))
+                 (byte-compile-warn
+                  "`%S' is not a condition name (in condition-case)" c)))
+             (byte-compile-push-constant condition)
+             (push (cons 'byte-pushconditioncase (car clause)) push-ops)))))
+      ;; Then emit the handler activations in reverse order so that the
+      ;; first handler becomes the innermost.
+      (dolist (op push-ops)
+        ;; Use the depth at which the jumps will take place in the tag.
+        (setq byte-compile-depth (1+ initial-depth))
+        (byte-compile-goto (car op) (cdr op)))
+      (cl-assert (equal byte-compile-depth initial-depth)))
 
     (byte-compile-form body) ;; byte-compile--for-effect
     (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index b37cfebab3..1651e47cfe 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -510,14 +510,18 @@ cconv-convert
                newprotform)
           ,@(mapcar
              (lambda (handler)
-               `(,(car handler)
-                 ,@(let ((body
-                          (mapcar (lambda (form)
-                                    (cconv-convert form newenv extend))
-                                  (cdr handler))))
-                     (if (not (eq class :captured+mutated))
-                         body
-                       `((let ((,var (list ,var))) ,@body))))))
+               (let ((head (pcase (car handler)
+                             (`(:catch ,tag-exp)
+                              `(:catch ,(cconv-convert tag-exp env extend)))
+                             (h h))))
+                 `(,head
+                   ,@(let ((body
+                            (mapcar (lambda (form)
+                                      (cconv-convert form newenv extend))
+                                    (cdr handler))))
+                       (if (not (eq class :captured+mutated))
+                           body
+                         `((let ((,var (list ,var))) ,@body)))))))
              handlers))))
 
     (`(unwind-protect ,form . ,body)
@@ -736,6 +740,10 @@ cconv-analyze-form
     (`(function . ,_) nil)              ; same as quote
 
     (`(condition-case ,var ,protected-form . ,handlers)
+     (dolist (handler handlers)
+       (pcase handler
+         (`((:catch ,tag-exp) . ,_)
+          (cconv-analyze-form tag-exp env))))
      (cconv-analyze-form protected-form env)
      (when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
        (byte-compile-warn
diff --git a/src/eval.c b/src/eval.c
index fd93f5b9e1..8a7676ec7a 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1351,6 +1351,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
   CHECK_SYMBOL (var);
 
   Lisp_Object success_handler = Qnil;
+  Lisp_Object tags = Qnil;	/* Evaluated catch tags in reverse order. */
 
   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
     {
@@ -1361,10 +1362,21 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 		     || CONSP (XCAR (tem))))))
 	error ("Invalid condition handler: %s",
 	       SDATA (Fprin1_to_string (tem, Qt)));
-      if (EQ (XCAR (tem), QCsuccess))
+      Lisp_Object head = XCAR (tem);
+      if (EQ (head, QCsuccess))
 	success_handler = XCDR (tem);
       else
-	clausenb++;
+	{
+	  if (CONSP (head) && EQ (XCAR (head), QCcatch))
+	    {
+	      if (NILP (XCDR (head)) || !NILP (XCDR (XCDR (head))))
+		error ("Invalid condition handler: %s",
+		       SDATA (Fprin1_to_string (tem, Qt)));
+	      Lisp_Object tag = eval_sub (XCAR (XCDR (head)));
+	      tags = Fcons (tag, tags);
+	    }
+	  clausenb++;
+	}
     }
 
   /* The first clause is the one that should be checked first, so it
@@ -1386,7 +1398,15 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
       Lisp_Object condition = CONSP (clause) ? XCAR (clause) : Qnil;
       if (!CONSP (condition))
 	condition = list1 (condition);
-      struct handler *c = push_handler (condition, CONDITION_CASE);
+      struct handler *c;
+      if (EQ (XCAR (condition), QCcatch))
+	{
+	  Lisp_Object tag = XCAR (tags);
+	  tags = XCDR (tags);
+	  c = push_handler (tag, CATCHER);
+	}
+      else
+	c = push_handler (condition, CONDITION_CASE);
       if (sys_setjmp (c->jmp))
 	{
 	  Lisp_Object val = handlerlist->val;
@@ -4409,6 +4429,7 @@ syms_of_eval (void)
   defsubr (&Sunwind_protect);
   defsubr (&Scondition_case);
   DEFSYM (QCsuccess, ":success");
+  DEFSYM (QCcatch, ":catch");
   defsubr (&Ssignal);
   defsubr (&Scommandp);
   defsubr (&Sautoload);
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index c9ab3ec1f1..af02810f31 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -503,6 +503,38 @@ bytecomp-tests--test-cases
                  (:success 'good))
                (1+ x))))
       (funcall f 3))
+
+    ;; Catching throws.
+    (let ((g (lambda (f)
+               (let ((tags (list 'a 'b)))
+                 (condition-case x
+                     (funcall f)
+                   ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                    (list 'catch-a x))
+                   ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                    (list 'catch-b x))
+                   (:success (list 'ok x)))))))
+      (list (funcall g (lambda () 2))
+            (funcall g (lambda () (throw 'a 3)))
+            (funcall g (lambda () (throw 'b 5)))))
+
+    ;; Catching throws and errors.
+    (let ((g (lambda (f)
+               (let ((tags (list 'a 'b)))
+                 (condition-case x
+                     (funcall f)
+                   ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                    (list 'catch-a x))
+                   (arith-error (list 'arith x))
+                   ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                    (list 'catch-b x))
+                   (error (list 'err x))
+                   (:success (list 'ok x)))))))
+      (list (funcall g (lambda () 2))
+            (funcall g (lambda () (throw 'a 3)))
+            (funcall g (lambda () (throw 'b 5)))
+            (funcall g (lambda () (/ 1 0)))
+            (funcall g (lambda () (signal 'error nil)))))
     )
   "List of expressions for cross-testing interpreted and compiled code.")
 
@@ -1310,7 +1342,45 @@ bytecomp-condition-case-success
                               (:success 'good))
                             (1+ x))))
                    (funcall f 3))
-                 4)))
+                 4))
+
+  ;; Catching throws.
+  (should (equal
+           (let ((g (lambda (f)
+                      (let ((tags (list 'a 'b)))
+                        (condition-case x
+                            (funcall f)
+                          ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                           (list 'catch-a x))
+                          ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                           (list 'catch-b x))
+                          (:success (list 'ok x)))))))
+             (list (funcall g (lambda () 2))
+                   (funcall g (lambda () (throw 'a 3)))
+                   (funcall g (lambda () (throw 'b 5)))))
+                 '((ok 2) (catch-a 3) (catch-b 5))))
+
+  ;; Catching throws and errors.
+  (should (equal
+           (let ((g (lambda (f)
+                      (let ((tags (list 'a 'b)))
+                        (condition-case x
+                            (funcall f)
+                          ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                           (list 'catch-a x))
+                          (arith-error (list 'arith x))
+                          ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                           (list 'catch-b x))
+                          (error (list 'err x))
+                          (:success (list 'ok x)))))))
+             (list (funcall g (lambda () 2))
+                   (funcall g (lambda () (throw 'a 3)))
+                   (funcall g (lambda () (throw 'b 5)))
+                   (funcall g (lambda () (/ 1 0)))
+                   (funcall g (lambda () (signal 'error nil)))))
+                 '((ok 2) (catch-a 3) (catch-b 5)
+                   (arith (arith-error)) (err (error)))))
+  )
 
 ;; Local Variables:
 ;; no-byte-compile: t

[-- Attachment #4: Type: text/plain, Size: 2 bytes --]




^ permalink raw reply related	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-12 19:20         ` Mattias Engdegård
@ 2021-04-13  7:38           ` Lars Ingebrigtsen
  2021-04-13  8:52             ` Mattias Engdegård
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Ingebrigtsen @ 2021-04-13  7:38 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: Stefan Monnier, 47677

Mattias Engdegård <mattiase@acm.org> writes:

> Here is an updated patch that reduces some code duplication in the
> compiler and fixes an embarrassing bug, and as a bonus, an
> experimental add-on that allows catching throws in condition-case
> using the handler syntax
>
>   ((:catch TAG) BODY...)

I'm not quite sure I understand the use case for this -- we already have
a general catch/throw infrastructure, so this sounds like a somewhat odd
addition.

That is, currently you know what to look for when reading code that does
a throw, and this introduces a second thing to look for, and I'm not
sure that's a net win.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-13  7:38           ` Lars Ingebrigtsen
@ 2021-04-13  8:52             ` Mattias Engdegård
  2021-04-14  9:29               ` Lars Ingebrigtsen
  0 siblings, 1 reply; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-13  8:52 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: Stefan Monnier, 47677

13 apr. 2021 kl. 09.38 skrev Lars Ingebrigtsen <larsi@gnus.org>:

>>  ((:catch TAG) BODY...)
> 
> I'm not quite sure I understand the use case for this -- we already have
> a general catch/throw infrastructure, so this sounds like a somewhat odd
> addition.

Oh, it was just proof-of-concept code to show that such a generalisation would be possible should it be desired later. It's not part of the immediate proposal. Sorry about the confusion.

Our present `catch` has the same flaw as `condition-case` in that it does not give access to the success continuation, leading to hacks similar to the one you mentioned. We could extend `catch` instead, maybe like this:

  (catch TAG :in BODY-FORM :success VAR SUCCESS-FORM)

but what if you want to catch multiple tags, or both throws and errors? The constructs don't compose; nesting them hides the success continuation of the inner forms.






^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-13  8:52             ` Mattias Engdegård
@ 2021-04-14  9:29               ` Lars Ingebrigtsen
  2021-04-15 13:54                 ` Mattias Engdegård
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Ingebrigtsen @ 2021-04-14  9:29 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: Stefan Monnier, 47677

Mattias Engdegård <mattiase@acm.org> writes:

> Oh, it was just proof-of-concept code to show that such a
> generalisation would be possible should it be desired later. It's not
> part of the immediate proposal. Sorry about the confusion.

Oh, OK.  :-)

> Our present `catch` has the same flaw as `condition-case` in that it
> does not give access to the success continuation, leading to hacks
> similar to the one you mentioned.

Yes, that's true.

> We could extend `catch` instead, maybe like this:
>
>   (catch TAG :in BODY-FORM :success VAR SUCCESS-FORM)
>
> but what if you want to catch multiple tags, or both throws and
> errors? The constructs don't compose; nesting them hides the success
> continuation of the inner forms.

Yeah, I think extending `catch' here would be less than optimal, but I
don't really have any suggestions here -- I use `throw/catch' so little
that I have no gut feeling about what I see as being useful.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-14  9:29               ` Lars Ingebrigtsen
@ 2021-04-15 13:54                 ` Mattias Engdegård
  2021-04-16  5:13                   ` Richard Stallman
                                     ` (2 more replies)
  0 siblings, 3 replies; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-15 13:54 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: Stefan Monnier, 47677

14 apr. 2021 kl. 11.29 skrev Lars Ingebrigtsen <larsi@gnus.org>:

> Yeah, I think extending `catch' here would be less than optimal, but I
> don't really have any suggestions here -- I use `throw/catch' so little
> that I have no gut feeling about what I see as being useful.

It's unfortunate that elisp has two incompatible variants, throw/catch and signal/condition-case, of essentially the same control structure. In practice throw/catch tends to be used more for non-error situations, but that's just a matter of style -- the underlying mechanisms are basically the same.

In any case the patch apparently wasn't bad enough to be rejected outright so it's boldly been pushed to master. If the general opinion is that :no-error (or something else) would be a better name than :success, I'll make the change in a blink.

I didn't do any serious search for places where the new construct would be profitably employed but there are bound to be a few. Have a look at `load-completions-from-file`, for example.






^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-15 13:54                 ` Mattias Engdegård
@ 2021-04-16  5:13                   ` Richard Stallman
  2021-04-16  5:13                   ` Richard Stallman
  2021-04-21 14:13                   ` Stefan Kangas
  2 siblings, 0 replies; 31+ messages in thread
From: Richard Stallman @ 2021-04-16  5:13 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: larsi, monnier, 47677

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > It's unfortunate that elisp has two incompatible variants,
  > throw/catch and signal/condition-case, of essentially the same
  > control structure.

It's not unfortunate, it's normal.  Other Lisp dialects have them
both, too.  There is a good reason for this: errors can invoke the
debugger.



-- 
Dr Richard Stallman
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)







^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-15 13:54                 ` Mattias Engdegård
  2021-04-16  5:13                   ` Richard Stallman
@ 2021-04-16  5:13                   ` Richard Stallman
  2021-04-21 14:13                   ` Stefan Kangas
  2 siblings, 0 replies; 31+ messages in thread
From: Richard Stallman @ 2021-04-16  5:13 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: larsi, monnier, 47677

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > It's unfortunate that elisp has two incompatible variants,
  > throw/catch and signal/condition-case, of essentially the same
  > control structure.

It's not unfortunate, it's normal.  Other Lisp dialects have them
both, too.  There is a good reason for this: errors can invoke the
debugger.

Emacs Lisp is not Scheme.  Does continuation-passing style work
usably in Emacs Lisp now?  I don't know for certain, but I would
be very surprised.

If not, let's keep things simple by not trying to define
constructs for that.  That simplicity is very important.

-- 
Dr Richard Stallman
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)







^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-15 13:54                 ` Mattias Engdegård
  2021-04-16  5:13                   ` Richard Stallman
  2021-04-16  5:13                   ` Richard Stallman
@ 2021-04-21 14:13                   ` Stefan Kangas
  2021-04-22 13:58                     ` Mattias Engdegård
  2 siblings, 1 reply; 31+ messages in thread
From: Stefan Kangas @ 2021-04-21 14:13 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: Lars Ingebrigtsen, Stefan Monnier, 47677

Mattias Engdegård <mattiase@acm.org> writes:

> 14 apr. 2021 kl. 11.29 skrev Lars Ingebrigtsen <larsi@gnus.org>:
>
>> Yeah, I think extending `catch' here would be less than optimal, but I
>> don't really have any suggestions here -- I use `throw/catch' so little
>> that I have no gut feeling about what I see as being useful.
>
> It's unfortunate that elisp has two incompatible variants, throw/catch and
> signal/condition-case, of essentially the same control structure. In practice
> throw/catch tends to be used more for non-error situations, but that's just a
> matter of style -- the underlying mechanisms are basically the same.
>
> In any case the patch apparently wasn't bad enough to be rejected outright so
> it's boldly been pushed to master. If the general opinion is that :no-error (or
> something else) would be a better name than :success, I'll make the change in a
> blink.
>
> I didn't do any serious search for places where the new construct
> would be profitably employed but there are bound to be a few. Have a
> look at `load-completions-from-file`, for example.

It seems like the patch here was pushed.

Should this be closed, or is there more to do here?





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-21 14:13                   ` Stefan Kangas
@ 2021-04-22 13:58                     ` Mattias Engdegård
  2021-04-23  4:18                       ` Richard Stallman
  2021-04-25 16:45                       ` Lars Ingebrigtsen
  0 siblings, 2 replies; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-22 13:58 UTC (permalink / raw)
  To: Stefan Kangas; +Cc: Lars Ingebrigtsen, Stefan Monnier, 47677

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

21 apr. 2021 kl. 16.13 skrev Stefan Kangas <stefan@marxist.se>:

> Should this be closed, or is there more to do here?

There's the business of fixing `catch` in the same way. (A new bug could be opened for it, but since it's intimately related we might as well do it here.) As mentioned, `catch` has three problems:

- no way to execute code when a throw is caught
- no way to execute code when the body terminates normally
- no way to catch both throws and errors

since neither `catch` nor `condition-case` compose with themselves or each other.
For example, it would be useful to have `pcase` match both the value of an expression as well as throws and errors from it.

Here is a proper patch, essentially a polished version of the previously posted diff. It adds `condition-case` clauses on the form

((:catch TAG-EXPR) BODY...)

where TAG-EXPR is evaluated before the protected form to a tag value, and BODY is executed when that tag is thrown, with the variable bound to the thrown value.


[-- Attachment #2: 0001-catch-handlers-in-condition-case-bug-47677.patch --]
[-- Type: application/octet-stream, Size: 12716 bytes --]

From 218db91619430d0f26ca3e17839e6669fd291e76 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Mon, 12 Apr 2021 20:40:23 +0200
Subject: [PATCH] `catch` handlers in `condition-case` (bug#47677)

Add handlers on the form

  ((:catch TAG) BODY...)

where TAG is an expression that is evaluated prior to the protected
form and yields a catch tag that is handled by BODY with the variable
bound to the thrown value.  For example,

  (condition-case x
      (throw 'meep 2)
    ((:catch 'meep) (+ x 3)))
  => 5

Multiple catch and error handlers can be mixed freely in the same
`condition-case` form, which can also include a :success clause.

In other words, this change remedies three problems: `catch` lacking
separate code branches for the throw and fall-through cases, and the
lack of composability with `condition-case` and `catch`.

* src/eval.c (internal_lisp_condition_case, syms_of_eval): Implement
in interpreter.
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyze-form):
* lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case): Implement
in byte-compiler.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases)
(bytecomp-condition-case-success): Add tests.
---
 lisp/emacs-lisp/bytecomp.el            | 44 ++++++++-----
 lisp/emacs-lisp/cconv.el               | 24 ++++---
 src/eval.c                             | 27 +++++++-
 test/lisp/emacs-lisp/bytecomp-tests.el | 91 +++++++++++++++++++++++++-
 4 files changed, 158 insertions(+), 28 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 4f91f0d5de..82e0edd772 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4636,22 +4636,34 @@ byte-compile-condition-case
       (byte-compile-warn
        "`%s' is not a variable-name or nil (in condition-case)" var))
 
-    (dolist (clause (reverse clauses))
-      (let ((condition (nth 1 clause)))
-        (unless (consp condition) (setq condition (list condition)))
-        (dolist (c condition)
-          (unless (and c (symbolp c))
-            (byte-compile-warn
-             "`%S' is not a condition name (in condition-case)" c))
-          ;; In reality, the `error-conditions' property is only required
-          ;; for the argument to `signal', not to `condition-case'.
-          ;;(unless (consp (get c 'error-conditions))
-          ;;  (byte-compile-warn
-          ;;   "`%s' is not a known condition name (in condition-case)"
-          ;;   c))
-          )
-        (byte-compile-push-constant condition))
-      (byte-compile-goto 'byte-pushconditioncase (car clause)))
+    (let ((initial-depth byte-compile-depth)
+          (push-ops nil))
+      ;; Push all conditions and tags in left-to-right order first,
+      ;; since tags need to be evaluated outside the scope of the handlers.
+      (dolist (clause clauses)
+        (let ((condition (nth 1 clause)))
+          (pcase condition
+            (`(:catch ,tag-expr)
+             (byte-compile-form tag-expr)
+             (push (cons 'byte-pushcatch (car clause)) push-ops))
+            (`(:catch . ,_)
+             (error "malformed :catch clause: `%S'" (cdr clause)))
+            (_             ; error clause
+             (unless (consp condition)
+               (setq condition (list condition)))
+             (dolist (c condition)
+               (unless (and c (symbolp c))
+                 (byte-compile-warn
+                  "`%S' is not a condition name (in condition-case)" c)))
+             (byte-compile-push-constant condition)
+             (push (cons 'byte-pushconditioncase (car clause)) push-ops)))))
+      ;; Then emit the handler activations in reverse order so that the
+      ;; first handler becomes the innermost.
+      (dolist (op push-ops)
+        ;; Use the depth at which the jumps will take place in the tag.
+        (setq byte-compile-depth (1+ initial-depth))
+        (byte-compile-goto (car op) (cdr op)))
+      (cl-assert (equal byte-compile-depth initial-depth)))
 
     (byte-compile-form body) ;; byte-compile--for-effect
     (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index f663710902..f92f9b7ed8 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -510,14 +510,18 @@ cconv-convert
                newprotform)
           ,@(mapcar
              (lambda (handler)
-               `(,(car handler)
-                 ,@(let ((body
-                          (mapcar (lambda (form)
-                                    (cconv-convert form newenv extend))
-                                  (cdr handler))))
-                     (if (not (eq class :captured+mutated))
-                         body
-                       `((let ((,var (list ,var))) ,@body))))))
+               (let ((head (pcase (car handler)
+                             (`(:catch ,tag-exp)
+                              `(:catch ,(cconv-convert tag-exp env extend)))
+                             (h h))))
+                 `(,head
+                   ,@(let ((body
+                            (mapcar (lambda (form)
+                                      (cconv-convert form newenv extend))
+                                    (cdr handler))))
+                       (if (not (eq class :captured+mutated))
+                           body
+                         `((let ((,var (list ,var))) ,@body)))))))
              handlers))))
 
     (`(unwind-protect ,form . ,body)
@@ -736,6 +740,10 @@ cconv-analyze-form
     (`(function . ,_) nil)              ; same as quote
 
     (`(condition-case ,var ,protected-form . ,handlers)
+     (dolist (handler handlers)
+       (pcase handler
+         (`((:catch ,tag-exp) . ,_)
+          (cconv-analyze-form tag-exp env))))
      (cconv-analyze-form protected-form env)
      (when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
        (byte-compile-warn
diff --git a/src/eval.c b/src/eval.c
index fd93f5b9e1..d4ed746458 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1351,6 +1351,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
   CHECK_SYMBOL (var);
 
   Lisp_Object success_handler = Qnil;
+  Lisp_Object tags = Qnil;	/* Evaluated catch tags in reverse order. */
 
   for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
     {
@@ -1361,10 +1362,21 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 		     || CONSP (XCAR (tem))))))
 	error ("Invalid condition handler: %s",
 	       SDATA (Fprin1_to_string (tem, Qt)));
-      if (EQ (XCAR (tem), QCsuccess))
+      Lisp_Object head = XCAR (tem);
+      if (EQ (head, QCsuccess))
 	success_handler = XCDR (tem);
       else
-	clausenb++;
+	{
+	  if (CONSP (head) && EQ (XCAR (head), QCcatch))
+	    {
+	      if (NILP (XCDR (head)) || !NILP (XCDR (XCDR (head))))
+		error ("Invalid catch handler: %s",
+		       SDATA (Fprin1_to_string (tem, Qt)));
+	      Lisp_Object tag = eval_sub (XCAR (XCDR (head)));
+	      tags = Fcons (tag, tags);
+	    }
+	  clausenb++;
+	}
     }
 
   /* The first clause is the one that should be checked first, so it
@@ -1386,7 +1398,15 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
       Lisp_Object condition = CONSP (clause) ? XCAR (clause) : Qnil;
       if (!CONSP (condition))
 	condition = list1 (condition);
-      struct handler *c = push_handler (condition, CONDITION_CASE);
+      struct handler *c;
+      if (EQ (XCAR (condition), QCcatch))
+	{
+	  Lisp_Object tag = XCAR (tags);
+	  tags = XCDR (tags);
+	  c = push_handler (tag, CATCHER);
+	}
+      else
+	c = push_handler (condition, CONDITION_CASE);
       if (sys_setjmp (c->jmp))
 	{
 	  Lisp_Object val = handlerlist->val;
@@ -4409,6 +4429,7 @@ syms_of_eval (void)
   defsubr (&Sunwind_protect);
   defsubr (&Scondition_case);
   DEFSYM (QCsuccess, ":success");
+  DEFSYM (QCcatch, ":catch");
   defsubr (&Ssignal);
   defsubr (&Scommandp);
   defsubr (&Sautoload);
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index c9ab3ec1f1..fb123ab600 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -503,6 +503,46 @@ bytecomp-tests--test-cases
                  (:success 'good))
                (1+ x))))
       (funcall f 3))
+
+    ;; Catching throws, simple.
+    (condition-case x
+        (throw 'z 7)
+      ((:catch 'z) (list 'got-z x)))
+    (condition-case x
+        (list 8)
+      ((:catch 'z) (list 'got-z x)))
+
+    ;; Catching throws.
+    (let ((g (lambda (f)
+               (let ((tags (list 'a 'b)))
+                 (condition-case x
+                     (funcall f)
+                   ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                    (list 'catch-a x))
+                   ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                    (list 'catch-b x))
+                   (:success (list 'ok x)))))))
+      (list (funcall g (lambda () 2))
+            (funcall g (lambda () (throw 'a 3)))
+            (funcall g (lambda () (throw 'b 5)))))
+
+    ;; Catching throws and errors.
+    (let ((g (lambda (f)
+               (let ((tags (list 'a 'b)))
+                 (condition-case x
+                     (funcall f)
+                   ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                    (list 'catch-a x))
+                   (arith-error (list 'arith x))
+                   ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                    (list 'catch-b x))
+                   (error (list 'err x))
+                   (:success (list 'ok x)))))))
+      (list (funcall g (lambda () 2))
+            (funcall g (lambda () (throw 'a 3)))
+            (funcall g (lambda () (throw 'b 5)))
+            (funcall g (lambda () (/ 1 0)))
+            (funcall g (lambda () (signal 'error nil)))))
     )
   "List of expressions for cross-testing interpreted and compiled code.")
 
@@ -1310,7 +1350,56 @@ bytecomp-condition-case-success
                               (:success 'good))
                             (1+ x))))
                    (funcall f 3))
-                 4)))
+                 4))
+
+  ;; Catching throws, simple.
+  (should (equal (condition-case x
+                     (throw 'z 7)
+                   ((:catch 'z) (list 'got-z x)))
+                 '(got-z 7)))
+
+  (should (equal (condition-case x
+                     (list 8)
+                   ((:catch 'z) (list 'got-z x)))
+                 '(8)))
+
+  ;; Catching throws.
+  (should (equal
+           (let ((g (lambda (f)
+                      (let ((tags (list 'a 'b)))
+                        (condition-case x
+                            (funcall f)
+                          ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                           (list 'catch-a x))
+                          ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                           (list 'catch-b x))
+                          (:success (list 'ok x)))))))
+             (list (funcall g (lambda () 2))
+                   (funcall g (lambda () (throw 'a 3)))
+                   (funcall g (lambda () (throw 'b 5)))))
+                 '((ok 2) (catch-a 3) (catch-b 5))))
+
+  ;; Catching throws and errors.
+  (should (equal
+           (let ((g (lambda (f)
+                      (let ((tags (list 'a 'b)))
+                        (condition-case x
+                            (funcall f)
+                          ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                           (list 'catch-a x))
+                          (arith-error (list 'arith x))
+                          ((:catch (prog1 (car tags) (setq tags (cdr tags))))
+                           (list 'catch-b x))
+                          (error (list 'err x))
+                          (:success (list 'ok x)))))))
+             (list (funcall g (lambda () 2))
+                   (funcall g (lambda () (throw 'a 3)))
+                   (funcall g (lambda () (throw 'b 5)))
+                   (funcall g (lambda () (/ 1 0)))
+                   (funcall g (lambda () (signal 'error nil)))))
+                 '((ok 2) (catch-a 3) (catch-b 5)
+                   (arith (arith-error)) (err (error)))))
+  )
 
 ;; Local Variables:
 ;; no-byte-compile: t
-- 
2.21.1 (Apple Git-122.3)


^ permalink raw reply related	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-22 13:58                     ` Mattias Engdegård
@ 2021-04-23  4:18                       ` Richard Stallman
  2021-04-24 17:02                         ` Mattias Engdegård
  2021-04-25 16:45                       ` Lars Ingebrigtsen
  1 sibling, 1 reply; 31+ messages in thread
From: Richard Stallman @ 2021-04-23  4:18 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: larsi, stefan, monnier, 47677

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > There's the business of fixing `catch` in the same way. (A new bug could be opened for it, but since it's intimately related we might as well do it here.) As mentioned, `catch` has three problems:

  > - no way to execute code when a throw is caught
  > - no way to execute code when the body terminates normally
  > - no way to catch both throws and errors

I do not agree that these are problems.  catch and throw are ok
as they are, and we should leave them alone.

catch is meant for intentional exits, and condition-case is meant for
catching errors.  If you want to handle both in one place, use both
constructs there.

If you want to do something after catch catches a throw, it is not hard
to implement that using the existing constructs.

  (if (catch 'foo
         (prog1 nil
            ...do stuff...))  ;; use (throw 'foo t) to exit
      do-if-throw
     do-if-no-throw)

given how rarely this is used, it's as easy as it needs to be, and
avoids making catch complicated.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)







^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-23  4:18                       ` Richard Stallman
@ 2021-04-24 17:02                         ` Mattias Engdegård
  2021-04-25  4:44                           ` Richard Stallman
  2021-04-26 15:12                           ` Filipp Gunbin
  0 siblings, 2 replies; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-24 17:02 UTC (permalink / raw)
  To: Richard Stallman; +Cc: larsi, stefan, monnier, 47677

23 apr. 2021 kl. 06.18 skrev Richard Stallman <rms@gnu.org>:

> catch and throw are ok
> as they are, and we should leave them alone.

And so we do! All we do here is to fill a few gaps in the system, but if you don't feel the need for it then you can just ignore that the new construct exist.

See the previous discussion for examples, but your code is also a good illustration:

>  (if (catch 'foo
>         (prog1 nil
>            ...do stuff...))  ;; use (throw 'foo t) to exit
>      do-if-throw
>     do-if-no-throw)

Here the throw transmits no useful value at all; if it did, this value would have to be restricted in some way, such as being non-nil. The Lisp implementation knows very well whether a throw occurred or not, so we can expose that information instead of having the user hack around the limitation.

Common uses of catch/throw include early exits from deep searches when a match is found, and then it is useful that the thrown value is unrestricted. Conversely, when `throw` is used to indicate a failure, it is useful to have the normal return value unrestricted.

The patch does not include the required documentation changes; naturally that will be remedied.






^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-24 17:02                         ` Mattias Engdegård
@ 2021-04-25  4:44                           ` Richard Stallman
  2021-04-25  7:35                             ` Eli Zaretskii
  2021-04-26 15:12                           ` Filipp Gunbin
  1 sibling, 1 reply; 31+ messages in thread
From: Richard Stallman @ 2021-04-25  4:44 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: larsi, stefan, monnier, 47677

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > And so we do! All we do here is to fill a few gaps in the system,
  > but if you don't feel the need for it then you can just ignore
  > that the new construct exist.

Hold your horses!  That is not the way to look at a adding complexity
to a basic Lisp construct.

Every additional feature added to a fundamental construct increases
the complexity of the Lisp language.  That always has various kinds of
cost whether it is used or not.  Since this added feature would rarely
be of use, it would have cost and no benefit.

Please do not add this feature.


-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)







^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-25  4:44                           ` Richard Stallman
@ 2021-04-25  7:35                             ` Eli Zaretskii
  2021-04-25 18:21                               ` bug#47677: [External] : " Drew Adams
  2021-04-26  4:40                               ` Richard Stallman
  0 siblings, 2 replies; 31+ messages in thread
From: Eli Zaretskii @ 2021-04-25  7:35 UTC (permalink / raw)
  To: rms; +Cc: mattiase, larsi, stefan, monnier, 47677

> From: Richard Stallman <rms@gnu.org>
> Date: Sun, 25 Apr 2021 00:44:23 -0400
> Cc: larsi@gnus.org, stefan@marxist.se, monnier@iro.umontreal.ca,
>  47677@debbugs.gnu.org
> 
> Hold your horses!  That is not the way to look at a adding complexity
> to a basic Lisp construct.
> 
> Every additional feature added to a fundamental construct increases
> the complexity of the Lisp language.  That always has various kinds of
> cost whether it is used or not.  Since this added feature would rarely
> be of use, it would have cost and no benefit.

FTR: I agree with you.  However, sadly this seems to be a minority
opinion in the current Emacs development: features are added to Emacs
Lisp left, right and center without any serious consideration of the
of the costs and benefits balance.  The pressure to add features to
Emacs Lisp is enormous.  It sometimes seems to me that some people
regard developing and extending Emacs Lisp to be the most important
aspects of the Emacs development.





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-22 13:58                     ` Mattias Engdegård
  2021-04-23  4:18                       ` Richard Stallman
@ 2021-04-25 16:45                       ` Lars Ingebrigtsen
  2021-04-26 11:53                         ` Mattias Engdegård
  1 sibling, 1 reply; 31+ messages in thread
From: Lars Ingebrigtsen @ 2021-04-25 16:45 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: Stefan Kangas, Stefan Monnier, 47677

Mattias Engdegård <mattiase@acm.org> writes:

>   (condition-case x
>       (throw 'meep 2)
>     ((:catch 'meep) (+ x 3)))
>   => 5
>
> Multiple catch and error handlers can be mixed freely in the same
> `condition-case` form, which can also include a :success clause.

Sorry; I'm not very enthusiastic about this construct -- it just seems
like an awkward hack to me.

condition-case is about handling errors -- it can be used as a general
flow control system, but that's an awkward fit.  It conveys intention.
So I don't think we should extend it to handle more throw/catch-like
things.

However, I do agree that Emacs Lisp could need some beefing up in the
"early return" department (which this is a kind of example of), but I
don't know what that would look like.  But I don't think it should look
like this.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [External] : bug#47677: [PATCH] condition-case success continuation
  2021-04-25  7:35                             ` Eli Zaretskii
@ 2021-04-25 18:21                               ` Drew Adams
  2021-04-25 18:24                                 ` Eli Zaretskii
  2021-04-26  4:40                               ` Richard Stallman
  1 sibling, 1 reply; 31+ messages in thread
From: Drew Adams @ 2021-04-25 18:21 UTC (permalink / raw)
  To: Eli Zaretskii, rms@gnu.org
  Cc: mattiase@acm.org, larsi@gnus.org, stefan@marxist.se,
	monnier@iro.umontreal.ca, 47677@debbugs.gnu.org

> > Hold your horses!  That is not the way to look at a adding complexity
> > to a basic Lisp construct.
> >
> > Every additional feature added to a fundamental construct increases
> > the complexity of the Lisp language.  That always has various kinds
> > of cost whether it is used or not.  Since this added feature would
> > rarely be of use, it would have cost and no benefit.
> 
> FTR: I agree with you.

+1.

> However, sadly this seems to be a minority
> opinion in the current Emacs development: features are added to Emacs
> Lisp left, right and center without any serious consideration of the
> of the costs and benefits balance.  The pressure to add features to
> Emacs Lisp is enormous.  It sometimes seems to me that some people
> regard developing and extending Emacs Lisp to be the most important
> aspects of the Emacs development.

Sad, yes.  FWIW, I'm in awe of the energy and patience you
devote to Emacs development, and I hope you don't burn out.






^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [External] : bug#47677: [PATCH] condition-case success continuation
  2021-04-25 18:21                               ` bug#47677: [External] : " Drew Adams
@ 2021-04-25 18:24                                 ` Eli Zaretskii
  0 siblings, 0 replies; 31+ messages in thread
From: Eli Zaretskii @ 2021-04-25 18:24 UTC (permalink / raw)
  To: Drew Adams; +Cc: rms, mattiase, stefan, 47677, monnier, larsi

> From: Drew Adams <drew.adams@oracle.com>
> CC: "mattiase@acm.org" <mattiase@acm.org>, "larsi@gnus.org" <larsi@gnus.org>,
>         "stefan@marxist.se" <stefan@marxist.se>,
>         "monnier@iro.umontreal.ca"
> 	<monnier@iro.umontreal.ca>,
>         "47677@debbugs.gnu.org" <47677@debbugs.gnu.org>
> Date: Sun, 25 Apr 2021 18:21:45 +0000
> 
> Sad, yes.  FWIW, I'm in awe of the energy and patience you
> devote to Emacs development, and I hope you don't burn out.

Thanks.





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-25  7:35                             ` Eli Zaretskii
  2021-04-25 18:21                               ` bug#47677: [External] : " Drew Adams
@ 2021-04-26  4:40                               ` Richard Stallman
  2021-04-26 12:44                                 ` Eli Zaretskii
  1 sibling, 1 reply; 31+ messages in thread
From: Richard Stallman @ 2021-04-26  4:40 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: mattiase, larsi, stefan, monnier, 47677

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > FTR: I agree with you.  However, sadly this seems to be a minority
  > opinion in the current Emacs development: features are added to Emacs
  > Lisp left, right and center without any serious consideration of the
  > of the costs and benefits balance.  The pressure to add features to
  > Emacs Lisp is enormous.

The reason GNU packages have maintainers is so that they can make
the design decisions.  We can stand against pressure.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)







^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-25 16:45                       ` Lars Ingebrigtsen
@ 2021-04-26 11:53                         ` Mattias Engdegård
  2021-04-27  3:46                           ` Richard Stallman
  0 siblings, 1 reply; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-26 11:53 UTC (permalink / raw)
  To: Lars Ingebrigtsen; +Cc: Stefan Kangas, Stefan Monnier, 47677

25 apr. 2021 kl. 18.45 skrev Lars Ingebrigtsen <larsi@gnus.org>:

> condition-case is about handling errors -- it can be used as a general
> flow control system, but that's an awkward fit.  It conveys intention.
> So I don't think we should extend it to handle more throw/catch-like
> things.

Most other languages use the same exception system for both errors and 'throws'; the distinction in Lisp is an artefact of history. Both are dynamically-scoped single-shot upwards-only value-conveying non-local control transfers (or described in continuation terms with about as many adjectives). The differences are minor.

Several times I've had to hack around the inability of `catch` to distinguish throws from normal termination and could go on doing so, but it feels like making function calls by manual variable assignment, stack operations and jumps. The byte code has no trouble expressing a more useful catch; it's just an arbitrary restriction in our Lisp primitives.

In addition, `catch` and `condition-case` don't compose. It would be interesting to design primitives that do but since that seems tricky (prove me wrong!), a unified `condition-case` does the job with a minimum of fuss and is definitely not a hack.

> However, I do agree that Emacs Lisp could need some beefing up in the
> "early return" department

Yes! But catch/throw is good for getting out of deep function call chains which is not quite the same thing. They are hard to optimise well for local use (exiting a loop or function) because it is difficult to prove the absence of throws elsewhere.

A variant of block/return-from would do, but better optimisations for local functions (TCO in particular) may be at least as useful.






^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-26  4:40                               ` Richard Stallman
@ 2021-04-26 12:44                                 ` Eli Zaretskii
  2021-04-27  3:46                                   ` Richard Stallman
  0 siblings, 1 reply; 31+ messages in thread
From: Eli Zaretskii @ 2021-04-26 12:44 UTC (permalink / raw)
  To: rms; +Cc: mattiase, larsi, stefan, monnier, 47677

> From: Richard Stallman <rms@gnu.org>
> Cc: mattiase@acm.org, larsi@gnus.org, stefan@marxist.se,
> 	monnier@iro.umontreal.ca, 47677@debbugs.gnu.org
> Date: Mon, 26 Apr 2021 00:40:01 -0400
> 
>   > FTR: I agree with you.  However, sadly this seems to be a minority
>   > opinion in the current Emacs development: features are added to Emacs
>   > Lisp left, right and center without any serious consideration of the
>   > of the costs and benefits balance.  The pressure to add features to
>   > Emacs Lisp is enormous.
> 
> The reason GNU packages have maintainers is so that they can make
> the design decisions.  We can stand against pressure.

IME, that only works up to a point.  When pressure becomes high enough
and from many contributors, standing fast against it has significant
negative effects: some people become frustrated and we risk losing
them, the general atmosphere becomes unpleasant, and if nothing else,
a lot of the maintainers' time is wasted on the dispute.  And this is
assuming all the maintainers agree, which is not always the case.

The only practical way to prevent such developments IME is to convince
people that they are wrong.  And that is not easy when the subject is
not exactly the maintainer's domain of expertise.





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-24 17:02                         ` Mattias Engdegård
  2021-04-25  4:44                           ` Richard Stallman
@ 2021-04-26 15:12                           ` Filipp Gunbin
  2021-04-27 15:31                             ` Mattias Engdegård
  1 sibling, 1 reply; 31+ messages in thread
From: Filipp Gunbin @ 2021-04-26 15:12 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: larsi, stefan, Richard Stallman, 47677, monnier

Please, let's not add such features to the basic Emacs Lisp constructs.
It's great to see Emacs Lisp being simple.





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-09 20:26 bug#47677: [PATCH] condition-case success continuation Mattias Engdegård
  2021-04-10 23:52 ` Stefan Monnier
@ 2021-04-26 21:57 ` Gregory Heytings
  1 sibling, 0 replies; 31+ messages in thread
From: Gregory Heytings @ 2021-04-26 21:57 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: 47677


>
> This patch adds the condition-case handler syntax
>
>  (:success BODY)
>
> for code executed when the protected form terminates without error. BODY 
> is then executed with the variable bound to the result of the protected 
> form, and the result of BODY is then the value of the condition-case 
> form as usual.
>
> This plugs an annoying hole in elisp: there hasn't been any direct 
> access to the success continuation
>

Would a macro not be enough to cover that particular programming pattern? 
E.g. something like:

(defmacro success-case (value action continuation &rest handlers)
   `(catch 'success-case-fail
      ((lambda (,value) ,continuation)
       (catch 'success-case-success
         (throw 'success-case-fail
                (condition-case ,value
                    (throw 'success-case-success ,action) ,@handlers))))))

With this macro you can write for example:

(success-case result
     (read buffer)
   (use result)
   (end-of-file 'eof))

which is IMO even more concise and elegant.





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-26 12:44                                 ` Eli Zaretskii
@ 2021-04-27  3:46                                   ` Richard Stallman
  0 siblings, 0 replies; 31+ messages in thread
From: Richard Stallman @ 2021-04-27  3:46 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: mattiase, larsi, stefan, monnier, 47677

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

Yes you can stand against pressure to make unwise changes.
So can I.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)







^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-26 11:53                         ` Mattias Engdegård
@ 2021-04-27  3:46                           ` Richard Stallman
  0 siblings, 0 replies; 31+ messages in thread
From: Richard Stallman @ 2021-04-27  3:46 UTC (permalink / raw)
  To: Mattias Engdegård; +Cc: larsi, stefan, monnier, 47677

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > Most other languages use the same exception system for both errors
  > and 'throws'; the distinction in Lisp is an artefact of history.

That's fine.  We are working with Lisp, not those other languages.

The most important thing about catch is to keep it stable.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)







^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-26 15:12                           ` Filipp Gunbin
@ 2021-04-27 15:31                             ` Mattias Engdegård
  2021-04-27 19:00                               ` Gregory Heytings
  2021-04-29 12:45                               ` Filipp Gunbin
  0 siblings, 2 replies; 31+ messages in thread
From: Mattias Engdegård @ 2021-04-27 15:31 UTC (permalink / raw)
  To: Filipp Gunbin
  Cc: Lars Ingebrigtsen, Stefan Kangas, Stefan Monnier, 47677-done

26 apr. 2021 kl. 17.12 skrev Filipp Gunbin <fgunbin@fastmail.fm>:

> Please, let's not add such features to the basic Emacs Lisp constructs.
> It's great to see Emacs Lisp being simple.

I'd like to clear up some misconceptions here. (Filipp, this does not mean that I think that you wrote something stupid -- quite the contrary.) 

First, is Emacs Lisp really simple? Yes and no. It's not easy to tell where its boundaries are, especially since it doesn't have a proper module or namespace system or a well-defined 'core language'. Basic semantics -- control structures, built-in types, primitives and so on -- are not too messy but definitely more than they need to be; Scheme it is not. No wonder given its age; it has held up remarkably well considering, but it would be even more remarkable if modern eyes could not find flaws in it.

Second, is simplicity paramount among concerns? Clearly not: compatibility matters, and so does programming usability. It is also not clear whether a change makes a language more or less simple; adding bignums, for example, probably made the language less complex for the user. Even if (hypothetically) people got by without `unwind-protect` by catching and re-raising errors, few would object to adding that construct as a special form because it made the language less simple.

Of course you were talking about changes that make the language more difficult to use, but my point is that it is far from clear what kind of change actually does that.

Unrelated to your comment: since several people have misunderstood the proposal, I'm closing the bug to avoid conflating issues (I should have listened to Stefan Kangas); a new one can be reopened for the patch at hand when and if I get more free time.






^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-27 15:31                             ` Mattias Engdegård
@ 2021-04-27 19:00                               ` Gregory Heytings
  2021-04-29 12:45                               ` Filipp Gunbin
  1 sibling, 0 replies; 31+ messages in thread
From: Gregory Heytings @ 2021-04-27 19:00 UTC (permalink / raw)
  To: Mattias Engdegård
  Cc: Filipp Gunbin, Lars Ingebrigtsen, Stefan Kangas, Stefan Monnier,
	47677


>
> Unrelated to your comment: since several people have misunderstood the 
> proposal, I'm closing the bug
>

I guess you did not see my previous post in this bug thread.

This bug should not be closed.  I agree with Richard and Eli, it is not 
necessary to add that feature to Elisp, the more so as it can be 
implemented with a short macro:

(defmacro if-success (var action continuation &rest handlers)
   "Regain control when an error is signaled, otherwise continue.
Execute ACTION and, if no error happened, CONTINUATION, with VAR
bound to the return value of ACTION.
Otherwise, execute the appropriate HANDLER, with VAR bound to
(ERROR-SYMBOL . SIGNAL-DATA)."
   `(catch 'success-case-failure
      ((lambda (,var) ,continuation)
       (catch 'success-case-success
         (throw 'success-case-failure
                (condition-case ,var
                    (throw 'success-case-success ,action) ,@handlers))))))





^ permalink raw reply	[flat|nested] 31+ messages in thread

* bug#47677: [PATCH] condition-case success continuation
  2021-04-27 15:31                             ` Mattias Engdegård
  2021-04-27 19:00                               ` Gregory Heytings
@ 2021-04-29 12:45                               ` Filipp Gunbin
  1 sibling, 0 replies; 31+ messages in thread
From: Filipp Gunbin @ 2021-04-29 12:45 UTC (permalink / raw)
  To: Mattias Engdegård
  Cc: Lars Ingebrigtsen, Stefan Kangas, Stefan Monnier, 47677-done

Mattias,

On 27/04/2021 17:31 +0200, Mattias Engdegård wrote:

> 26 apr. 2021 kl. 17.12 skrev Filipp Gunbin <fgunbin@fastmail.fm>:
>
>> Please, let's not add such features to the basic Emacs Lisp constructs.
>> It's great to see Emacs Lisp being simple.
>
> I'd like to clear up some misconceptions here. (Filipp, this does not
> mean that I think that you wrote something stupid -- quite the
> contrary.)
>
> First, is Emacs Lisp really simple? Yes and no. It's not easy to tell
> where its boundaries are, especially since it doesn't have a proper
> module or namespace system or a well-defined 'core language'. Basic
> semantics -- control structures, built-in types, primitives and so on
> -- are not too messy but definitely more than they need to be; Scheme
> it is not. No wonder given its age; it has held up remarkably well
> considering, but it would be even more remarkable if modern eyes could
> not find flaws in it.
>
> Second, is simplicity paramount among concerns? Clearly not:
> compatibility matters, and so does programming usability. It is also
> not clear whether a change makes a language more or less simple;
> adding bignums, for example, probably made the language less complex
> for the user. Even if (hypothetically) people got by without
> `unwind-protect` by catching and re-raising errors, few would object
> to adding that construct as a special form because it made the
> language less simple.
>
> Of course you were talking about changes that make the language more
> difficult to use, but my point is that it is far from clear what kind
> of change actually does that.

Yes, there're no objective criteria for simplicity.  I should have
stated more clearly what I meant.  I just like that Elisp is not
overloaded with functionality and syntactic sugar.  The docstrings of
many constructs (catch in particular) are short and clear.  That allows
(relatively) easy entry for non-lispers (I remember myself 8 years or so
ago).  For more complex things, if a macro way is possible, I think it
should be preferred.

Filipp





^ permalink raw reply	[flat|nested] 31+ messages in thread

end of thread, other threads:[~2021-04-29 12:45 UTC | newest]

Thread overview: 31+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-04-09 20:26 bug#47677: [PATCH] condition-case success continuation Mattias Engdegård
2021-04-10 23:52 ` Stefan Monnier
2021-04-11 11:13   ` Mattias Engdegård
2021-04-12  8:49     ` Lars Ingebrigtsen
2021-04-12 15:10       ` Stefan Monnier
2021-04-12 19:20         ` Mattias Engdegård
2021-04-13  7:38           ` Lars Ingebrigtsen
2021-04-13  8:52             ` Mattias Engdegård
2021-04-14  9:29               ` Lars Ingebrigtsen
2021-04-15 13:54                 ` Mattias Engdegård
2021-04-16  5:13                   ` Richard Stallman
2021-04-16  5:13                   ` Richard Stallman
2021-04-21 14:13                   ` Stefan Kangas
2021-04-22 13:58                     ` Mattias Engdegård
2021-04-23  4:18                       ` Richard Stallman
2021-04-24 17:02                         ` Mattias Engdegård
2021-04-25  4:44                           ` Richard Stallman
2021-04-25  7:35                             ` Eli Zaretskii
2021-04-25 18:21                               ` bug#47677: [External] : " Drew Adams
2021-04-25 18:24                                 ` Eli Zaretskii
2021-04-26  4:40                               ` Richard Stallman
2021-04-26 12:44                                 ` Eli Zaretskii
2021-04-27  3:46                                   ` Richard Stallman
2021-04-26 15:12                           ` Filipp Gunbin
2021-04-27 15:31                             ` Mattias Engdegård
2021-04-27 19:00                               ` Gregory Heytings
2021-04-29 12:45                               ` Filipp Gunbin
2021-04-25 16:45                       ` Lars Ingebrigtsen
2021-04-26 11:53                         ` Mattias Engdegård
2021-04-27  3:46                           ` Richard Stallman
2021-04-26 21:57 ` Gregory Heytings

Code repositories for project(s) associated with this external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.