mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Add condition-case success handler (bug#47677)

Browse source 
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.
This commit is contained in:
Mattias Engdegård 2021-04-07 11:31:07 +02:00
parent 31f8ae53be
commit 7893945cc8
7 changed files with 218 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

61
lisp/emacs-lisp/bytecomp.el
View file

@ -4621,10 +4621,15 @@ binding slots have been popped."
(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 @@ binding slots have been popped."
(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)))
(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-out-tag endtag)))
(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))))