summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2015-10-28 06:05:39 -0700
committerKaz Kylheku <kaz@kylheku.com>2015-10-28 06:05:39 -0700
commitacfd125f2351a294f8872da5736169ea3c51786b (patch)
tree215aa945752633e5f08fa7c293c8f201b07ff308
parente13399f6ca7ae0c59c1e176ff5e4c78d00f82c69 (diff)
downloadtxr-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.125
-rw-r--r--unwind.c15
-rw-r--r--unwind.h2
3 files changed, 24 insertions, 18 deletions
diff --git a/txr.1 b/txr.1
index 885bdb11..c90a4200 100644
--- a/txr.1
+++ b/txr.1
@@ -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])))
diff --git a/unwind.c b/unwind.c
index 0202f4e4..fe3c68b6 100644
--- a/unwind.c
+++ b/unwind.c
@@ -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));
}
diff --git a/unwind.h b/unwind.h
index b2242661..a9b456ae 100644
--- a/unwind.h
+++ b/unwind.h
@@ -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);