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.

1 files changed, 14 insertions, 0 deletions

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