From 710889ccdf6f8f8501f0a9409258b3850002d41d Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 10 Apr 2019 16:34:09 -0700 Subject: New catch** macro. * lisplib.c (except_set_entries): Autoload for catch** symbol. * share/txr/stdlib/except.tl (catch**): New macro. * txr.1: Document catch** macro, and the desc slot of the catch-frame struct. --- share/txr/stdlib/except.tl | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'share') diff --git a/share/txr/stdlib/except.tl b/share/txr/stdlib/except.tl index a2cc684c..73ba253d 100644 --- a/share/txr/stdlib/except.tl +++ b/share/txr/stdlib/except.tl @@ -41,6 +41,20 @@ (let ((catch-syms [mapcar car catch-clauses])) ^(sys:catch ,catch-syms ,try-form nil ,*catch-clauses))) +(defmacro catch** (try-form . catch-clauses) + (let ((catch-syms [mapcar car catch-clauses]) + sys-catch-clauses descs) + (each ((cl catch-clauses)) + (mac-param-bind cl (type desc args . body) cl + (push ^(,type ,args ,*body) sys-catch-clauses) + (push desc descs))) + (sys:setq sys-catch-clauses (nreverse sys-catch-clauses)) + (sys:setq descs (nreverse descs)) + (let ((desc-expr (if [all descs constantp] + ^'(,*[mapcar eval descs]) + ^(list ,*descs)))) + ^(sys:catch ,catch-syms ,try-form ,desc-expr ,*sys-catch-clauses)))) + (defun sys:expand-handle (form try-form handle-clauses) (let* ((oper (car form)) (exc-sym (gensym)) -- cgit v1.2.3