From 06d0ada8a9ff7078f8ab89d5b4ce36f04587dc62 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 29 Apr 2019 06:48:00 -0700 Subject: debugger: expand frames. This patch adds special unwind frames for backtracing expansions. With this, we can get rid of the global variable last_form_expanded, since to get the last form expanded, we just search for the most enclosing expand frame. * eval.c (last_form_expanded): Global variable removed. (error_trace): Use uw_last_form_expanded() instead of last_form_expanded. (expand_eval): No need to save and restore last_form_expanded any more. (expand_lisp_setq, expand_setqf, expand_lisp1, do_expand): Use uw_last_form_expanded(). (expand, do_macroexpand_1): Push and pop expand frame. This fixes a bug: do_macroexpand_1 was not recording last_form_expanded. Evaluation of top-level forms uses explicit macroexpansion, therefore top-level evaluation was neglecting to set last_form_expanded. This explains weird behavior I saw in the listener from time to time, when errors would report against the expansion of the wrong form. (eval_init): Remove reference to last_form_expanded variable. * eval.h (last_form_expanded): Declaration removed. * share/txr/stdlib/debug.tl (expand-frame print-trace, expand-frame loc): New methods. (print-backtrace): Include uw-expand frames in the backtrace. * unwind.c (expand_frame_type): New static variable. (uw_find_frames_by_mask): Handle UW_EXPAND. (uw_last_form_expanded, uw_push_expand): New functions. (uw_late_init): Register expand-frame struct type. * unwind.h (enum uw_frtype): New enum member, UW_EXPAND. (uw_last_form_expanded, uw_push_expand): Declared. --- eval.c | 71 ++++++++++++++++++++++++-------------------- eval.h | 2 +- share/txr/stdlib/debugger.tl | 11 ++++++- unwind.c | 40 ++++++++++++++++++++++++- unwind.h | 6 +++- 5 files changed, 93 insertions(+), 37 deletions(-) diff --git a/eval.c b/eval.c index 43e499d8..1435c0d1 100644 --- a/eval.c +++ b/eval.c @@ -106,7 +106,7 @@ val eval_only_s, compile_only_s; val special_s, unbound_s; val whole_k, form_k, symacro_k; -val last_form_evaled, last_form_expanded; +val last_form_evaled; val call_f; @@ -359,6 +359,7 @@ val set_last_form_evaled(val form) void error_trace(val exsym, val exvals, val out_stream, val prefix) { val last = last_form_evaled; + val xlast = uw_last_form_expanded(); val info = source_loc_str(last, nil); if (cdr(exvals) || !stringp(car(exvals))) @@ -401,23 +402,23 @@ void error_trace(val exsym, val exvals, val out_stream, val prefix) } } - if (last_form_expanded) { - val ex_info = source_loc_str(last_form_expanded, nil); - val form = last_form_expanded; + if (xlast) { + val ex_info = source_loc_str(xlast, nil); + val form = xlast; if (ex_info) format(out_stream, lit("~a during expansion at ~a of form ~!~s\n"), - prefix, ex_info, last_form_expanded, nao); + prefix, ex_info, xlast, nao); else format(out_stream, lit("~a during expansion of form ~!~s\n"), - prefix, last_form_expanded, nao); + prefix, xlast, nao); if (info) format(out_stream, lit("~a by macro code located at ~a\n"), prefix, info, nao); for (;;) { - val origin = lookup_origin(form); + val origin = lookup_origin(xlast); val oinfo = source_loc_str(origin, nil); if (origin) { @@ -1433,13 +1434,11 @@ val funcall_interp(val interp_fun, struct args *args) static val expand_eval(val form, val env) { val lfe_save = last_form_evaled; - val lfx_save = last_form_expanded; - val form_ex = (last_form_expanded = last_form_evaled = nil, + val form_ex = (last_form_evaled = nil, expand(form, nil)); val loading = cdr(lookup_var(dyn_env, load_recursive_s)); val ret = ((void) (loading || uw_release_deferred_warnings()), eval(form_ex, default_null_arg(env), form)); - last_form_expanded = lfx_save; last_form_evaled = lfe_save; return ret; } @@ -2389,7 +2388,7 @@ static val expand_lisp1_setq(val form, val menv) eval_error(form, lit("~s: misapplied to form ~s"), op, sym, nao); if (!lookup_var(nil, sym) && !lookup_fun(nil, sym)) - eval_defr_warn(last_form_expanded, + eval_defr_warn(uw_last_form_expanded(), cons(var_s, sym), lit("~s: unbound variable/function ~s"), op, sym, nao); @@ -2421,7 +2420,7 @@ static val expand_setqf(val form, val menv) eval_error(form, lit("~s: cannot assign lexical function ~s"), op, sym, nao); if (!lookup_fun(nil, sym)) - eval_defr_warn(last_form_expanded, + eval_defr_warn(uw_last_form_expanded(), cons(fun_s, sym), lit("~s: unbound function ~s"), op, sym, nao); @@ -3310,7 +3309,7 @@ tail: !uw_tentative_def_exists(cons(var_s, form)) && !uw_tentative_def_exists(cons(fun_s, form))) { - eval_defr_warn(last_form_expanded, + eval_defr_warn(uw_last_form_expanded(), cons(sym_s, form), lit("unbound variable/function ~s"), form, nao); } @@ -4535,7 +4534,7 @@ again: return expand(rlcp_tree(symac, form), menv); } if (!lookup_var(menv, form)) - eval_defr_warn(last_form_expanded, + eval_defr_warn(uw_last_form_expanded(), cons(var_s, form), lit("unbound variable ~s"), form, nao); return form; @@ -4710,13 +4709,13 @@ again: } if (!lookup_fun(menv, arg)) { if (special_operator_p(arg)) - eval_warn(last_form_expanded, + eval_warn(uw_last_form_expanded(), lit("fun used on special operator ~s"), arg, nao); else if (!bindable(arg)) - eval_warn(last_form_expanded, + eval_warn(uw_last_form_expanded(), lit("~s appears in operator position"), arg, nao); else - eval_defr_warn(last_form_expanded, + eval_defr_warn(uw_last_form_expanded(), cons(fun_s, arg), lit("unbound function ~s"), arg, nao); @@ -4876,10 +4875,10 @@ again: insym_ex = expand(insym, menv); } else if (!lookup_fun(menv, sym) && !special_operator_p(sym)) { if (!bindable(sym)) - eval_warn(last_form_expanded, + eval_warn(uw_last_form_expanded(), lit("~s appears in operator position"), sym, nao); else - eval_defr_warn(last_form_expanded, + eval_defr_warn(uw_last_form_expanded(), cons(fun_s, sym), lit("unbound function ~s"), sym, nao); @@ -4909,16 +4908,19 @@ again: val expand(val form, val menv) { val ret = nil; - val lfe_save = last_form_expanded; +#if CONFIG_DEBUG_SUPPORT + uw_frame_t expand_fr; + uw_push_expand(&expand_fr, form, menv); +#endif - if (consp(form)) - last_form_expanded = form; ret = do_expand(form, menv); - last_form_expanded = lfe_save; if (!lookup_origin(ret)) set_origin(ret, form); +#if CONFIG_DEBUG_SUPPORT + uw_pop_frame(&expand_fr); +#endif return ret; } @@ -5000,23 +5002,26 @@ val macro_form_p(val form, val menv) static val do_macroexpand_1(val form, val menv, val (*lookup)(val, val)) { val macro; +#if CONFIG_DEBUG_SUPPORT + uw_frame_t expand_fr; + uw_push_expand(&expand_fr, form, menv); +#endif menv = default_null_arg(menv); if (consp(form) && (macro = lookup_mac(menv, car(form)))) { val mac_expand = expand_macro(form, macro, menv); - if (mac_expand == form) - return form; - return rlcp_tree(rlcp_tree(mac_expand, form), macro); - } - - if (bindable(form) && (macro = lookup(menv, form))) { + if (mac_expand != form) + form = rlcp_tree(rlcp_tree(mac_expand, form), macro); + } else if (bindable(form) && (macro = lookup(menv, form))) { val mac_expand = cdr(macro); - if (mac_expand == form) - return form; - return rlcp_tree(mac_expand, macro); + if (mac_expand != form) + form = rlcp_tree(mac_expand, macro); } +#if CONFIG_DEBUG_SUPPORT + uw_pop_frame(&expand_fr); +#endif return form; } @@ -6112,7 +6117,7 @@ void eval_init(void) val length_f = func_n1(length); protect(&top_vb, &top_fb, &top_mb, &top_smb, &special, &builtin, &dyn_env, - &op_table, &pm_table, &last_form_evaled, &last_form_expanded, + &op_table, &pm_table, &last_form_evaled, &call_f, &unbound_s, &origin_hash, convert(val *, 0)); top_fb = make_hash(t, nil, nil); top_vb = make_hash(t, nil, nil); diff --git a/eval.h b/eval.h index c538941e..f61968f9 100644 --- a/eval.h +++ b/eval.h @@ -30,7 +30,7 @@ extern val hash_lit_s, hash_construct_s, struct_lit_s, qref_s, uref_s; extern val eval_error_s, if_s, call_s; extern val eq_s, eql_s, equal_s; extern val car_s, cdr_s; -extern val last_form_evaled, last_form_expanded; +extern val last_form_evaled; extern val load_path_s, load_recursive_s; extern val special_s, struct_s; diff --git a/share/txr/stdlib/debugger.tl b/share/txr/stdlib/debugger.tl index 8eeb9ce2..26f30741 100644 --- a/share/txr/stdlib/debugger.tl +++ b/share/txr/stdlib/debugger.tl @@ -78,6 +78,15 @@ ^[,(cadr form)] ^(,sym))))))) +(defmeth expand-frame print-trace (fr pr-fr nx-fr prefix) + (let* ((form fr.form) + (loc (source-loc-str form))) + (put-string `@prefix X:@(if loc `(@loc):`)`) + (prinl form))) + +(defmeth expand-frame loc (fr) + (source-loc-str fr.form)) + (defun print-backtrace (: (*stdout* *stdout*) (prefix "")) (with-resources ((imode (set-indent-mode *stdout* indent-foff) (set-indent-mode *stdout* imode)) @@ -86,7 +95,7 @@ (length (set-max-length *stdout* 10) (set-max-length *stdout* length))) (window-map 1 nil (lambda (pr el nx) el.(print-trace pr nx prefix)) - (find-frames-by-mask (logior uw-fcall uw-eval))))) + (find-frames-by-mask (logior uw-fcall uw-eval uw-expand))))) (defun debugger () (with-disabled-debugging diff --git a/unwind.c b/unwind.c index 48852dbc..ca8762fd 100644 --- a/unwind.c +++ b/unwind.c @@ -67,7 +67,7 @@ static val sys_cont_s, sys_cont_poison_s; static val sys_cont_free_s, sys_capture_cont_s; static val frame_type, catch_frame_type, handle_frame_type; -static val fcall_frame_type, eval_frame_type; +static val fcall_frame_type, eval_frame_type, expand_frame_type; static val deferred_warnings, tentative_defs; @@ -440,6 +440,13 @@ val uw_find_frames_by_mask(val mask_in) slotset(frame, env_s, fr->el.env); break; } + case UW_EXPAND: + { + frame = allocate_struct(expand_frame_type); + slotset(frame, form_s, fr->el.form); + slotset(frame, env_s, fr->el.env); + break; + } default: break; } @@ -454,6 +461,22 @@ val uw_find_frames_by_mask(val mask_in) #endif +#if CONFIG_DEBUG_SUPPORT + +val uw_last_form_expanded(void) +{ + uw_frame_t *fr; + + for (fr = uw_stack; fr != 0; fr = fr->uw.up) { + if (fr->uw.type == UW_EXPAND) + return fr->el.form; + } + + return nil; +} + +#endif + val uw_invoke_catch(val catch_frame, val sym, struct args *args) { uw_frame_t *ex, *ex_point; @@ -593,6 +616,16 @@ void uw_push_eval(uw_frame_t *fr, val form, val env) uw_stack = fr; } +void uw_push_expand(uw_frame_t *fr, val form, val env) +{ + memset(fr, 0, sizeof *fr); + fr->el.type = UW_EXPAND; + fr->el.form = form; + fr->el.env = env; + fr->el.up = uw_stack; + uw_stack = fr; +} + #endif static val exception_subtypes; @@ -1184,6 +1217,10 @@ void uw_late_init(void) frame_type, nil, list(form_s, env_s, nao), nil, nil, nil, nil); + expand_frame_type = make_struct_type(intern(lit("expand-frame"), user_package), + frame_type, nil, + list(form_s, env_s, nao), + nil, nil, nil, nil); #endif reg_mac(intern(lit("defex"), user_package), func_n2(me_defex)); reg_var(unhandled_hook_s = intern(lit("*unhandled-hook*"), @@ -1220,6 +1257,7 @@ void uw_late_init(void) reg_varl(intern(lit("uw-guard"), system_package), num_fast(1U <