diff options
| -rw-r--r-- | eval.c | 16 | ||||
| -rw-r--r-- | eval.h | 1 | ||||
| -rw-r--r-- | parser.c | 15 | ||||
| -rw-r--r-- | unwind.c | 10 |
4 files changed, 36 insertions, 6 deletions
@@ -104,6 +104,8 @@ val last_form_evaled, last_form_expanded; val call_f; +val origin_hash; + val make_env(val vbindings, val fbindings, val up_env) { val env = make_obj(); @@ -188,6 +190,11 @@ noreturn val eval_error(val form, val fmt, ...) abort(); } +val lookup_origin(val form) +{ + return gethash(origin_hash, form); +} + val lookup_global_var(val sym) { uses_or2; @@ -1487,7 +1494,9 @@ static val expand_macro(val form, val expander, val menv) { if (cobjp(expander)) { mefun_t fp = coerce(mefun_t, cptr_get(expander)); - return fp(form, menv); + val expanded = fp(form, menv); + sethash(origin_hash, expanded, form); + return expanded; } else { debug_enter; val name = car(form); @@ -1504,6 +1513,7 @@ static val expand_macro(val form, val expander, val menv) result = eval_progn(body, exp_env, body); debug_end; set_dyn_env(saved_de); + sethash(origin_hash, result, form); debug_return(result); debug_leave; } @@ -4189,7 +4199,7 @@ void eval_init(void) protect(&top_vb, &top_fb, &top_mb, &top_smb, &special, &builtin, &dyn_env, &op_table, &last_form_evaled, &last_form_expanded, - &call_f, convert(val *, 0)); + &call_f, &origin_hash, convert(val *, 0)); top_fb = make_hash(t, nil, nil); top_vb = make_hash(t, nil, nil); top_mb = make_hash(t, nil, nil); @@ -4202,6 +4212,8 @@ void eval_init(void) call_f = func_n1v(generic_funcall); + origin_hash = make_hash(t, nil, nil); + dwim_s = intern(lit("dwim"), user_package); progn_s = intern(lit("progn"), user_package); prog1_s = intern(lit("prog1"), user_package); @@ -31,6 +31,7 @@ extern val eq_s, eql_s, equal_s; extern val last_form_evaled, last_form_expanded; noreturn val eval_error(val form, val fmt, ...); +val lookup_origin(val form); val make_env(val fbindings, val vbindings, val up_env); val copy_env(val oenv); val env_fbind(val env, val sym, val fun); @@ -753,6 +753,7 @@ val repl(val bindings, val in_stream, val out_stream) } else if (uw_exception_subtype_p(exsym, error_s)) { val info = source_loc_str(last_form_evaled, nil); val ex_info = source_loc_str(last_form_expanded, nil); + val origin = last_form_evaled; if (cdr(exvals)) format(out_stream, lit("** ~!~a ~!~s\n"), @@ -760,13 +761,21 @@ val repl(val bindings, val in_stream, val out_stream) else format(out_stream, lit("** ~!~a\n"), car(exvals), nao); - if (info && exsym != eval_error_s) - format(std_error, lit("** possibly triggered at ~a by form ~!~s\n"), + if (info && exsym != eval_error_s) { + format(out_stream, lit("** possibly triggered at ~a by form ~!~s\n"), info, last_form_evaled, nao); + while ((origin = lookup_origin(origin))) { + val oinfo = source_loc_str(origin, lit("(n/a)")); + format(out_stream, lit("** which is an expansion at ~a of ~!~s\n"), + oinfo, origin, nao); + } + } + if (ex_info) - format(std_error, lit("** during expansion at ~a of form ~!~s\n"), + format(out_stream, lit("** during expansion at ~a of form ~!~s\n"), ex_info, last_form_expanded, nao); + } else { format(out_stream, lit("** ~!~s exception, args: ~!~s\n"), exsym, exvals, nao); @@ -535,13 +535,21 @@ val uw_throw(val sym, val args) val msg_or_args = if3(is_msg, car(args), args); val info = source_loc_str(last_form_evaled, nil); val ex_info = source_loc_str(last_form_expanded, nil); + val origin = last_form_evaled; format(std_error, lit("~a: unhandled exception of type ~a:\n"), prog_string, sym, nao); - if (info && sym != eval_error_s) + if (info && sym != eval_error_s) { format(std_error, lit("~a: possibly triggered at ~a by form ~!~s\n"), prog_string, info, last_form_evaled, nao); + while ((origin = lookup_origin(origin))) { + val oinfo = source_loc_str(origin, lit("(n/a)")); + format(std_error, lit("~a: which is an expansion at ~a of ~!~s\n"), + prog_string, oinfo, origin, nao); + } + } + if (ex_info) format(std_error, lit("~a: during expansion at ~a of form ~!~s\n"), prog_string, ex_info, last_form_expanded, nao); |