diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2015-10-28 06:05:39 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2015-10-28 06:05:39 -0700 |
commit | acfd125f2351a294f8872da5736169ea3c51786b (patch) | |
tree | 215aa945752633e5f08fa7c293c8f201b07ff308 | |
parent | e13399f6ca7ae0c59c1e176ff5e4c78d00f82c69 (diff) | |
download | txr-acfd125f2351a294f8872da5736169ea3c51786b.tar.gz txr-acfd125f2351a294f8872da5736169ea3c51786b.tar.bz2 txr-acfd125f2351a294f8872da5736169ea3c51786b.zip |
Context form error reporting in sys:capture-cont.
* unwind.c (sys_capture_cont_s): New variable.
(uw_capture_cont): Second argument is now a context
form rather than a symbol; eval_error is used for error
reporting. The form's operator symbol si used in the
error message, or else sys:capture-cont if the
context argument is null or missing.
(uw_late_init): Initialize sys_capture_cont_s.
* unwind.h (uw_capture_cont): Declaration updated.
* txr.1: Documented.
-rw-r--r-- | txr.1 | 25 | ||||
-rw-r--r-- | unwind.c | 15 | ||||
-rw-r--r-- | unwind.h | 2 |
3 files changed, 24 insertions, 18 deletions
@@ -27413,7 +27413,7 @@ as the closure body terminates. .coNP Function @ sys:capture-cont .synb -.mets (sys:capture-cont < name << error-report-sym ) +.mets (sys:capture-cont < name <> [ context-form ]) .syne .desc The @@ -27427,13 +27427,15 @@ A block named must be visible; the continuation is delimited by the closest enclosing block of this name. -The -.meta error-report-sym -argument should be a symbol. It is used in the error message if +The optional +.meta context-form +argument should be a compound form. If +.code sys:capture-cont +reports an error, it reports it against this form, +and uses the form's operator symbol as the name of the function which +encountered the error. If the argument is omitted, .code sys:capture-cont -is incorrectly used. The intent is that higher level constructs built -on this function can pass their own name, so the resulting diagnostic -pertains to these constructs, rather than the lower level interface. +uses its own name. The .code sys:capture-cont @@ -27503,16 +27505,17 @@ with named prompts. (defmacro reset (name . body) ^(block ,name ,*body)) - (defun shft-helper (name fun) - (let ((val (sys:capture-cont name 'shft))) + (defun shft-helper (name fun ctx) + (let ((val (sys:capture-cont name ctx))) (if (car val) (call fun (lambda (arg) (call (cdr val) arg))) (cdr val)))) - (defmacro shft (name var . body) + (defmacro shft (:form ctx name var . body) ^(shft-helper ',name - (lambda (,var) (return-from ,name ,*body)))) + (lambda (,var) (return-from ,name ,*body)) + ',ctx)) ;; Usage: (reset foo (* 2 (shft foo k [k 3]) (shft foo l [l 4]))) @@ -51,6 +51,7 @@ static uw_frame_t *uw_exit_point; static uw_frame_t toplevel_env; static val unhandled_hook_s, types_s, jump_s, sys_cont_s; +static val sys_capture_cont_s; static val frame_type, catch_frame_type, handle_frame_type; @@ -746,7 +747,7 @@ static val capture_cont(val tag, uw_frame_t *block) return result; } -val uw_capture_cont(val tag, val ctx) +val uw_capture_cont(val tag, val ctx_form) { uw_frame_t *fr; @@ -757,12 +758,13 @@ val uw_capture_cont(val tag, val ctx) } if (!fr) { + uses_or2; + val sym = or2(car(default_bool_arg(ctx_form)), sys_capture_cont_s); + if (tag) - uw_throwf(error_s, lit("~s: no block ~s is visible"), - ctx, tag, nao); + eval_error(ctx_form, lit("~s: no block ~s is visible"), sym, tag, nao); else - uw_throwf(error_s, lit("~s: no anonymous block is visible"), - ctx, nao); + eval_error(ctx_form, lit("~s: no anonymous block is visible"), sym, nao); abort(); } @@ -812,5 +814,6 @@ void uw_late_init(void) reg_fun(intern(lit("find-frame"), user_package), func_n2o(uw_find_frame, 0)); reg_fun(intern(lit("invoke-catch"), user_package), func_n2v(uw_invoke_catch)); - reg_fun(intern(lit("capture-cont"), system_package), func_n2(uw_capture_cont)); + reg_fun(sys_capture_cont_s = intern(lit("capture-cont"), system_package), + func_n2o(uw_capture_cont, 1)); } @@ -124,7 +124,7 @@ uw_frame_t *uw_current_exit_point(void); val uw_get_frames(void); val uw_find_frame(val extype, val frtype); val uw_invoke_catch(val catch_frame, val sym, struct args *); -val uw_capture_cont(val tag, val ctx); +val uw_capture_cont(val tag, val ctx_form); void uw_init(void); void uw_late_init(void); |