From c485146a246ab4b69e6ec510ec47713897f4d463 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 25 Jan 2017 10:57:12 -0800 Subject: New handle* macro, analogous to catch*. * share/txr/stdlib/except.tl (sys:expand-handle): New function. (handle): Use sys:expand-handle to expand arguments. The previously unused :whole form argument is now put to use, and correctly captured using :form rather than :whole. (handle*): New macro. * txr.1: Documented. --- share/txr/stdlib/except.tl | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'share') diff --git a/share/txr/stdlib/except.tl b/share/txr/stdlib/except.tl index abba8bdb..0f81e763 100644 --- a/share/txr/stdlib/except.tl +++ b/share/txr/stdlib/except.tl @@ -38,8 +38,9 @@ (let ((catch-syms [mapcar car catch-clauses])) ^(sys:catch ,catch-syms ,try-form ,*catch-clauses))) -(defmacro handle (:whole form try-form . handle-clauses) - (let* ((exc-sym (gensym)) +(defun sys:expand-handle (form try-form handle-clauses) + (let* ((oper (car form)) + (exc-sym (gensym)) (exc-args (gensym)) (syms-fragments (collect-each ((hc handle-clauses)) (tree-case hc @@ -47,8 +48,9 @@ (unless (symbolp name) (sys:handle-bad-syntax hc)) (list name ^(apply (lambda ,arglist ,*body) - ,*(if (and (plusp sys:compat) - (<= 161 sys:compat)) + ,*(if (or (eq oper 'handle*) + (and (plusp sys:compat) + (<= 161 sys:compat))) ^(,exc-sym)) ,exc-args))) (else (sys:handle-bad-syntax hc)))))) @@ -59,5 +61,11 @@ ,[mapcar car syms-fragments] ,try-form))) +(defmacro handle (:form form try-form . handle-clauses) + (sys:expand-handle form try-form handle-clauses)) + +(defmacro handle* (:form form try-form . handle-clauses) + (sys:expand-handle form try-form handle-clauses)) + (defmacro ignwarn (. forms) ^(handler-bind (lambda (exc-sym arg) (throw 'continue)) (warning) ,*forms)) -- cgit v1.2.3