diff options
| -rw-r--r-- | autoload.c | 17 | ||||
| -rw-r--r-- | eval.c | 36 | ||||
| -rw-r--r-- | stdlib/expander-let.tl | 44 |
3 files changed, 35 insertions, 62 deletions
@@ -934,22 +934,6 @@ static val constfun_instantiate(void) return nil; } -static val expander_let_set_entries(val fun) -{ - val name[] = { - lit("expander-let"), - nil - }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val expander_let_instantiate(void) -{ - load(scat2(stdlib_path, lit("expander-let"))); - return nil; -} - static val load_args_set_entries(val fun) { val name[] = { @@ -1109,7 +1093,6 @@ void autoload_init(void) autoload_reg(doc_instantiate, doc_set_entries); autoload_reg(pic_instantiate, pic_set_entries); autoload_reg(constfun_instantiate, constfun_set_entries); - autoload_reg(expander_let_instantiate, expander_let_set_entries); autoload_reg(load_args_instantiate, load_args_set_entries); autoload_reg(csort_instantiate, csort_set_entries); autoload_reg(glob_instantiate, glob_set_entries); @@ -106,7 +106,7 @@ val promise_s, promise_forced_s, promise_inprogress_s, force_s; val op_s, identity_s; val hash_lit_s, hash_construct_s, struct_lit_s, qref_s, uref_s; val vector_lit_s, vec_list_s, tree_lit_s, tree_construct_s; -val macro_time_s, macrolet_s; +val macro_time_s, macrolet_s, expander_let_s; val defsymacro_s, symacrolet_s, prof_s, switch_s, struct_s; val fbind_s, lbind_s, flet_s, labels_s; val load_path_s, load_hooks_s, load_recursive_s, load_search_dirs_s; @@ -5052,6 +5052,36 @@ static val expand_switch(val form, val menv) return rlcp(cons(sym, cons(expr_ex, cons(branches_ex, nil))), form); } +static val expand_expander_let(val form, val menv) +{ + val op = car(form); + val body = (syn_check(form, op, cdr, 0), cdr(form)); + val bindings = pop(&body); + val iter, ret; + + val saved_de = set_dyn_env(make_env(nil, nil, dyn_env)); + + for (iter = bindings; iter; iter = cdr(iter)) { + val binding = car(iter); + val var = pop(&binding); + val init = pop(&binding); + val init_ex = macroexpand(init, menv); + val value = if3(consp(init_ex) && car(init_ex) == dvbind_s, + eval(caaar(init_ex), nil, form), + eval(init_ex, nil, form)); + if (!special_var_p(var)) + expand_error(form, lit("~s is required to be a special variable"), + var, nao); + env_vbind(dyn_env, var, value); + } + + ret = expand_forms(body, menv); + + dyn_env = saved_de; + + return maybe_progn(ret); +} + static val do_expand(val form, val menv) { val macro = nil; @@ -5361,6 +5391,8 @@ again: return expand_macrolet(form, menv); } else if (sym == symacrolet_s) { return expand_symacrolet(form, menv); + } else if (sym == expander_let_s) { + return expand_expander_let(form, menv); } else if (sym == dwim_s) { val eh = expand_hook; if (eh) { @@ -7309,6 +7341,7 @@ void eval_init(void) macro_time_s = intern(lit("macro-time"), user_package); macrolet_s = intern(lit("macrolet"), user_package); symacrolet_s = intern(lit("symacrolet"), user_package); + expander_let_s = intern(lit("expander-let"), user_package); whole_k = intern(lit("whole"), keyword_package); form_k = intern(lit("form"), keyword_package); special_s = intern(lit("special"), system_package); @@ -7336,6 +7369,7 @@ void eval_init(void) reg_op(macrolet_s, op_error); reg_op(symacrolet_s, op_error); + reg_op(expander_let_s, op_error); reg_op(var_s, op_meta_error); reg_op(expr_s, op_meta_error); reg_op(quote_s, op_quote); diff --git a/stdlib/expander-let.tl b/stdlib/expander-let.tl deleted file mode 100644 index b31e4643..00000000 --- a/stdlib/expander-let.tl +++ /dev/null @@ -1,44 +0,0 @@ -;; Copyright 2023-2025 -;; Kaz Kylheku <kaz@kylheku.com> -;; Vancouver, Canada -;; All rights reserved. -;; -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions are met: -;; -;; 1. Redistributions of source code must retain the above copyright notice, -;; this list of conditions and the following disclaimer. -;; -;; 2. Redistributions in binary form must reproduce the above copyright notice, -;; this list of conditions and the following disclaimer in the documentation -;; and/or other materials provided with the distribution. -;; -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE -;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -;; POSSIBILITY OF SUCH DAMAGE. - -(defmacro usr:expander-let (:form f :env e vars . body) - (let (syms values) - (each ((pair vars)) - (tree-case pair - ((sym init) - (unless (special-var-p sym) - (compile-warning f "~s is required to be a special variable" sym)) - (push sym syms) - (push - (if-match (sys:dv-bind @sym @form) init - (eval form) - (eval init)) - values)) - (else - (compile-warning f "not a var-init form: ~s" else)))) - (progv (nreverse syms) (nreverse values) - (expand ^(progn ,*body) e)))) |