diff options
| -rw-r--r-- | eval.c | 16 | ||||
| -rw-r--r-- | stdlib/error.tl | 51 | ||||
| -rw-r--r-- | tests/019/load-hook.tl | 6 |
3 files changed, 37 insertions, 36 deletions
@@ -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*))) |