From 0f544070713a7dd93aa759dd71cf02fadd05814c Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 31 Dec 2016 20:37:37 -0800 Subject: Bugfix: repeated expansion of catch unstable. It turns out we have a silly problem: catch is a special operator, which undergoes a macro-like expansion which alters its syntax, but uses the same operator symbol. We turn catch into a macro which expands to a sys:catch operator. * eval.c (sys_catch_s): New symbol variable. (expand_catch): Function now expands sys:catch forms without altering any syntax. (do_expand): Check for sys:catch rather than catch. Call expand_catch differently: it takes the form now instead of just the arguments, so it can return the original form if no expansion takes place. (eval_init): Initialize sys_catch_s variable. Change registration of op_catch to sys:catch symbol. * lisplib.c (except_set_entries): Add catch to the list of autoload symbols for except.tl. * share/txr/stdlib/except.tl (catch): New macro for transforming catch to sys:catch. * txr.1: Reclassify catch operator as a macro. --- eval.c | 29 +++++++++++++++++------------ lisplib.c | 2 +- share/txr/stdlib/except.tl | 4 ++++ txr.1 | 10 +++++----- 4 files changed, 27 insertions(+), 18 deletions(-) diff --git a/eval.c b/eval.c index 1adc8e62..0ff18ba0 100644 --- a/eval.c +++ b/eval.c @@ -74,7 +74,7 @@ val eval_initing; val eval_error_s; val dwim_s, progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s, dvbind_s; -val handler_bind_s, cond_s, if_s, iflet_s, when_s; +val sys_catch_s, handler_bind_s, cond_s, if_s, iflet_s, when_s; val defvar_s, defvarl_s, defparm_s, defparml_s, defun_s, defmacro_s, macro_s; val tree_case_s, tree_bind_s, mac_param_bind_s; val sys_mark_special_s; @@ -3630,21 +3630,25 @@ static val expand_catch_clause(val form, val menv) return rlcp(cons(sym, cons(params_ex, body_ex)), form); } -static val expand_catch(val body, val menv) +static val expand_catch(val form, val menv) { - val try_form = first(body); - val catch_clauses = rest(body); - val catch_syms = mapcar(car_f, catch_clauses); + val args = form; + val sym = pop(&args); + val catch_syms = pop(&args); + val try_form = pop(&args); + val catch_clauses = args; val try_form_ex = expand(try_form, menv); val catch_clauses_ex = rlcp(mapcar(curry_12_1(func_n2(expand_catch_clause), menv), catch_clauses), catch_clauses); - val expanded = cons(catch_s, - cons(catch_syms, - cons(try_form_ex, catch_clauses_ex))); - return rlcp(expanded, body); + if (try_form_ex == try_form && catch_clauses_ex == catch_clauses) + return form; + + return rlcp(cons(sym, + cons(catch_syms, + cons(try_form_ex, catch_clauses_ex))), form); } static val expand_list_of_form_lists(val lofl, val menv, val ss_hash) @@ -3896,8 +3900,8 @@ static val do_expand(val form, val menv) if (quasi == quasi_ex) return form; return rlcp(cons(sym, quasi_ex), form); - } else if (sym == catch_s) { - return expand_catch(rest(form), menv); + } else if (sym == sys_catch_s) { + return expand_catch(form, menv); } else if (sym == handler_bind_s) { val args = rest(form); val fun = pop(&args); @@ -4985,6 +4989,7 @@ void eval_init(void) labels_s = intern(lit("labels"), user_package); call_s = intern(lit("call"), user_package); dvbind_s = intern(lit("dvbind"), system_package); + sys_catch_s = intern(lit("catch"), system_package); handler_bind_s = intern(lit("handler-bind"), user_package); cond_s = intern(lit("cond"), user_package); caseq_s = intern(lit("caseq"), user_package); @@ -5137,7 +5142,7 @@ void eval_init(void) reg_op(sys_abscond_from_s, op_abscond_from); reg_op(dwim_s, op_dwim); reg_op(quasi_s, op_quasi_lit); - reg_op(catch_s, op_catch); + reg_op(sys_catch_s, op_catch); reg_op(handler_bind_s, op_handler_bind); reg_op(with_dyn_rebinds_s, op_with_dyn_rebinds); reg_op(prof_s, op_prof); diff --git a/lisplib.c b/lisplib.c index 76e142e8..2423274a 100644 --- a/lisplib.c +++ b/lisplib.c @@ -239,7 +239,7 @@ static val hash_instantiate(val set_fun) static val except_set_entries(val dlt, val fun) { val name[] = { - lit("handle"), lit("ignwarn"), lit("macro-time-ignwarn"), + lit("catch"), lit("handle"), lit("ignwarn"), lit("macro-time-ignwarn"), nil }; set_dlt_entries(dlt, name, fun); diff --git a/share/txr/stdlib/except.tl b/share/txr/stdlib/except.tl index dee1bb6f..f7f87b0a 100644 --- a/share/txr/stdlib/except.tl +++ b/share/txr/stdlib/except.tl @@ -27,6 +27,10 @@ (defun sys:handle-bad-syntax (item) (throwf 'eval-error "~s: bad clause syntax: ~s" 'handle item)) +(defmacro catch (try-form . handle-clauses) + (let ((catch-syms [mapcar car handle-clauses])) + ^(sys:catch ,catch-syms ,try-form ,*handle-clauses))) + (defmacro handle (:whole form try-form . handle-clauses) (let* ((exc-sym (gensym)) (exc-args (gensym)) diff --git a/txr.1 b/txr.1 index 4f8e52ef..90d580e4 100644 --- a/txr.1 +++ b/txr.1 @@ -32246,7 +32246,7 @@ A is found which matches the exception, and control is transferred to the catch. Catches are defined by the .code catch -operator. +macro. .IP - A handler accepts the exception by performing a non-local transfer. Handlers are defined by the @@ -32415,7 +32415,7 @@ has the same semantics as .codn handler-bind , providing only convenient syntax. -\*(TL provides an operator called +\*(TL provides a macro called .code catch which has the same syntax as .code handle @@ -32425,7 +32425,7 @@ clause matches an exception, a dynamic control transfer takes place from the throw site to the catch site. Then the clause body is executed. The .code catch -operator resembles ANSI CL's +macro resembles ANSI CL's .code restart-case or possibly .codn handler-case , @@ -32551,7 +32551,7 @@ using the .code format string and additional arguments. -.coNP Operator @ catch +.coNP Macro @ catch .synb .mets (catch < try-expression .mets \ \ >> {( symbol <> ( arg *) << body-form *)}*) @@ -32559,7 +32559,7 @@ string and additional arguments. .desc The .code catch -operator establishes an exception catching block around +macro establishes an exception catching block around the .metn try-expression . The -- cgit v1.2.3