From ad068f27d819465c78c574019f32a2e1d30ca5ff Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 16 Nov 2023 00:45:49 -0800 Subject: stdlib/error.tl problem rears its head. There used to be a hack in the Makefile whereby the compilation of stdlib/error.tl was forced to occur earlier. I got rid of it. Now, the issue that was solving reproduced. A situation can occur whereby loading error.tl triggers loading some other files, which end up performing an expansion that needs sys:bind-mac-check: but that function has not yet been defined because error.tl has not yet loaded that far. The issue occurs when stdlib/place.tl is compiled before stdlib/error.tl. The compiled place.tl has a run-time dependency on functions in error.tl, because the compiled version of mac-param-bind and other forms relies on a run-time support function sys:bind-mac-check defined in stdlib/error.tl. * stdlib/error.tl (sys:dig): This function triggers the problem, but it's not the only cause. Here, the problem is because the (set ...) macro is used which triggers loading the stdlib/place module. That brings in the need for bind-mac-params. So here we use sys:setq instead. That is not a complete solution. The changes in eval.c are also required, because built-in macros like whilet expand to code that uses the (set ...) macro. Note how sys:dig uses whilet. (sys:bind-mac-check, sys:bind-mac-error): We move these functions above compile-warning. This addresses remaining circularity problem. The compile-warning function uses the catch macro which brings in stdlib/except.tl, which pulls in stdlib/op.tl due to its use of (do ...), which pulls in stdlib/place.tl. So if we already define sys:bind-mac-check at that point, we are good. * eval.c: Sweep the file for almost all places where macros generate code that invokes (set ) and replace that with (sys:setq ) to eliminate the dependency on loading the stdlib/place.tl module. (me_def_variable, me_gun, me_while_until_star, me_case, me_whilet, me_mlet, me_load_for, me_pop_after_load): In all these macro expanders, use sys:setq rather than set in the generated code. * tests/019/load-hook.tl: Some test cases here look for a macro expansion containing (set ...), needing to be fixed to look for (sys:setq ...) due to the change in eval.c. --- eval.c | 16 ++++++++-------- stdlib/error.tl | 51 +++++++++++++++++++++++++------------------------- tests/019/load-hook.tl | 6 +++--- 3 files changed, 37 insertions(+), 36 deletions(-) diff --git a/eval.c b/eval.c index a1409fb8..72635252 100644 --- a/eval.c +++ b/eval.c @@ -3276,7 +3276,7 @@ static val me_def_variable(val form, val menv) cons(list(sys_mark_special_s, list(quote_s, sym, nao), nao), nil)); val setval = if2(op == defparm_s || op == defparml_s, - cons(list(set_s, sym, initform, nao), nil)); + cons(list(setq_s, sym, initform, nao), nil)); val mksv = nappend2(mkspecial, setval); (void) menv; @@ -3365,7 +3365,7 @@ static val me_gun(val form, val menv) val expr = (syn_check(form, car(form), cdr, cddr), second(form)); (void) menv; return list(let_s, cons(var, nil), - list(gen_s, list(set_s, var, expr, nao), var, nao), nao); + list(gen_s, list(setq_s, var, expr, nao), var, nao), nao); } static val me_delay(val form, val menv) @@ -3452,7 +3452,7 @@ static val me_while_until_star(val form, val menv) (void) menv; return apply_frob_args(list(for_s, cons(list(once, t, nao), nil), cons(list(or_s, once, test, nao), nil), - cons(list(set_s, once, nil, nao), nil), + cons(list(setq_s, once, nil, nao), nil), rest(rest(form)), nao)); } @@ -4411,7 +4411,7 @@ static val me_case(val form, val menv) tformsym, nao), list(intern(lit("<="), user_package), minkey, tformsym, maxkey, nao), - list(set_s, + list(setq_s, swres, list(switch_s, if3(minkey == 0, @@ -4554,7 +4554,7 @@ static val me_whilet(val form, val env) list(let_star_s, lets, list(if_s, car(lastlet), cons(progn_s, body), - list(set_s, not_done, nil, nao), nao), nao), nao), nao); + list(setq_s, not_done, nil, nao), nao), nao), nao), nao); } static val me_iflet_whenlet(val form, val env) @@ -4673,7 +4673,7 @@ static val me_mlet(val form, val menv) ptail_smacs = list_collect(ptail_smacs, list(sym, list(force_s, gen, nao), nao)); ptail_sets = list_collect(ptail_sets, - list(set_s, gen, + list(setq_s, gen, list(delay, init, nao), nao)); } else { ptail_osyms = list_collect(ptail_osyms, sym); @@ -4747,7 +4747,7 @@ static val me_load_for(val form, val menv) static val me_push_after_load(val form, val menv) { (void) menv; - return list(set_s, + return list(setq_s, load_hooks_s, list(cons_s, cons(lambda_s, cons(nil, cdr(form))), @@ -4760,7 +4760,7 @@ static val me_pop_after_load(val form, val menv) (void) menv; if (cdr(form)) expand_error(form, lit("~s: no arguments required"), car(form), nao); - return list(set_s, load_hooks_s, list(cdr_s, load_hooks_s, nao), nao); + return list(setq_s, load_hooks_s, list(cdr_s, load_hooks_s, nao), nao); } void run_load_hooks(val load_dyn_env) diff --git a/stdlib/error.tl b/stdlib/error.tl index 0e50c671..11f1d094 100644 --- a/stdlib/error.tl +++ b/stdlib/error.tl @@ -29,12 +29,37 @@ (whilet ((form (sys:ctx-form ctx)) (anc (unless (source-loc form) (macro-ancestor form)))) - (set ctx anc)) + (sys:setq ctx anc)) ctx) (defun sys:loc (ctx) (source-loc-str (sys:ctx-form ctx))) +(defun sys:bind-mac-check (ctx-form params obj req fix) + (if (and obj (atom obj)) + (compile-error ctx-form "extra element ~s not matched by params ~a" + obj params) + (let ((l (len obj))) + (iflet ((problem (cond + ((< l req) "few") + ((and fix (> l fix)) "many")))) + (if (zerop l) + (compile-error ctx-form "params ~a require arguments" params) + (compile-error ctx-form "too ~a elements in ~s for params ~a" + problem obj params)))))) + +(defun sys:bind-mac-error (ctx-form params obj too-few-p) + (cond + ((atom obj) + (compile-error ctx-form "extra element ~s not matched by params ~a" + obj params)) + ((null obj) + (compile-error ctx-form "params ~a require arguments" params)) + (t (compile-error ctx-form "too ~a elements in ~s for params ~a" + (if too-few-p "few" "many") + obj params)))) + + (defun compile-error (ctx fmt . args) (let* ((nctx (sys:dig ctx)) (loc (sys:loc nctx)) @@ -62,30 +87,6 @@ (throw 'defr-warning (fmt `@loc: warning: ~s: @fmt` name . args) tag) (continue ())))) -(defun sys:bind-mac-error (ctx-form params obj too-few-p) - (cond - ((atom obj) - (compile-error ctx-form "extra element ~s not matched by params ~a" - obj params)) - ((null obj) - (compile-error ctx-form "params ~a require arguments" params)) - (t (compile-error ctx-form "too ~a elements in ~s for params ~a" - (if too-few-p "few" "many") - obj params)))) - -(defun sys:bind-mac-check (ctx-form params obj req fix) - (if (and obj (atom obj)) - (compile-error ctx-form "extra element ~s not matched by params ~a" - obj params) - (let ((l (len obj))) - (iflet ((problem (cond - ((< l req) "few") - ((and fix (> l fix)) "many")))) - (if (zerop l) - (compile-error ctx-form "params ~a require arguments" params) - (compile-error ctx-form "too ~a elements in ~s for params ~a" - problem obj params)))))) - (defun lambda-too-many-args (form) (compile-error form "excess arguments given")) diff --git a/tests/019/load-hook.tl b/tests/019/load-hook.tl index e62e689b..af0b9860 100644 --- a/tests/019/load-hook.tl +++ b/tests/019/load-hook.tl @@ -19,10 +19,10 @@ (mtest (macroexpand-1 '(push-after-load)) - (set *load-hooks* (cons (lambda ()) *load-hooks*)) + (sys:setq *load-hooks* (cons (lambda ()) *load-hooks*)) (macroexpand-1 '(push-after-load x)) - (set *load-hooks* (cons (lambda () x) *load-hooks*)) + (sys:setq *load-hooks* (cons (lambda () x) *load-hooks*)) (macroexpand-1 '(pop-after-load)) - (set *load-hooks* (cdr *load-hooks*))) + (sys:setq *load-hooks* (cdr *load-hooks*))) -- cgit v1.2.3