diff options
| -rw-r--r-- | lisplib.c | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/except.tl | 14 | ||||
| -rw-r--r-- | txr.1 | 30 |
3 files changed, 44 insertions, 2 deletions
@@ -270,7 +270,7 @@ static val hash_instantiate(val set_fun) static val except_set_entries(val dlt, val fun) { val name[] = { - lit("catch"), lit("catch*"), lit("handle"), lit("handle*"), + lit("catch"), lit("catch*"), lit("catch**"), lit("handle"), lit("handle*"), lit("ignwarn"), lit("macro-time-ignwarn"), nil }; 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)) @@ -38662,6 +38662,8 @@ string and additional arguments. .mets \ \ >> {( symbol <> ( arg *) << body-form *)}*) .mets (catch* < try-expression .mets \ \ >> {( symbol >> ( type-arg << arg *) << body-form *)}*) +.mets (catch** < try-expression +.mets \ \ >> {( symbol < desc >> ( type-arg << arg *) << body-form *)}*) .syne .desc The @@ -38728,6 +38730,19 @@ Then the exception arguments follow. In contrast, only the exception arguments are passed to the clauses of .codn catch . +The +.code catch** +macro is a further variant, which differs from +.code catch* +by requiring each catch clause to provide a description +.metn desc , +an expression which evaluates to a character string. +The +.meta desc +expressions are evaluated in left-to-right order prior to the +evaluation of +.metn try-expression . + Also see: the .code unwind-protect operator, and the functions @@ -39297,7 +39312,7 @@ and not a derived representation. .coNP Structures @, frame @ catch-frame and @ handle-frame .synb .mets (defstruct frame nil) -.mets (defstruct catch-frame frame types jump) +.mets (defstruct catch-frame frame types desc jump) .mets (defstruct handle-frame frame types fun) .syne .desc @@ -39341,6 +39356,19 @@ slot. This holds the list of exception type symbols which are matched by the catch or handler. The +.code desc +slot of a +.code catch-frame +holds a list of the descriptions produced by the +.code catch** +macro. If there are no descriptions, then this member is +.codn nil , +otherwise it is a list whose elements are in correspondence +with the list in the +.code types +slot. + +The .code jump slot of a .code catch-frame |