From cd117af02bd09f0172bf5693bcc362bf57588e27 Mon Sep 17 00:00:00 2001 From: Tadashi Saito Date: Sat, 22 Feb 2025 11:57:51 +0900 Subject: [PATCH] WIP --- schaf.c | 50 +++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 47 insertions(+), 3 deletions(-) diff --git a/schaf.c b/schaf.c index ed71022..c18e7a0 100644 --- a/schaf.c +++ b/schaf.c @@ -1417,9 +1417,39 @@ static Value transpose_2xn(Value ls) // 2 * n static Value define_variable(Value *env, Value ident, Value expr); -static Value let(Value *env, const char *func, Value bindings, Value body) +#define pp(v) do { \ + printf(#v": "); display(v); puts(""); fflush(stdout); \ + } while (0); + +static Value let(Value *env, UNUSED const char *func, Value bindings, Value body) { expect_type(func, TYPE_PAIR, bindings); + /* printf("<>\n"); */ + /* pp(bindings); */ + Value tr = transpose_2xn(bindings); + Value params = car(tr), symargs = cadr(tr); +#if 0 + Value proc = value_of_closure(*env, params, body); + Value args = map_eval(env, symargs); + /* pp(symargs); */ + /* pp(args); */ + return apply_closure(env, proc, args); +#elif 0 + Value args = Qnil; + Value letenv = *env; + for (Value p = params, a = symargs; p != Qnil; p = cdr(p), a = cdr(a)) { + Value ident = car(p), expr = car(a); + expect_type(func, TYPE_SYMBOL, ident); + Value arg = eval(env, expr); + args = cons(arg, args); + env_put(&letenv, ident, arg); + } + return eval_body(&letenv, body); + /* Value proc = value_of_closure(*env, params, body); */ + /* pp(proc); */ + /* return apply_closure(env, proc, args); */ +#elif 1 + Value args = Qnil; Value letenv = *env; for (Value p = bindings; p != Qnil; p = cdr(p)) { Value b = car(p); @@ -1428,18 +1458,32 @@ static Value let(Value *env, const char *func, Value bindings, Value body) runtime_error("%s: malformed binding in let: %s", func, stringify(b)); Value ident = car(b), expr = cadr(b); expect_type(func, TYPE_SYMBOL, ident); - env_put(&letenv, ident, eval(env, expr)); + symargs = cons(expr, symargs); + Value arg = eval(env, expr); + args = cons(arg, args); + env_put(&letenv, ident, arg); + //env_put(&letenv, ident, eval(env, expr)); } - return eval_body(&letenv, body); + /* return eval_body(&letenv, body); */ + Value proc = value_of_closure(*env, params, body); + Value qproc = list2(SYM_QUOTE, proc); + pp(params); + pp(args); + return apply(&letenv, qproc, args); +#endif } static Value named_let(Value *env, Value var, Value bindings, Value body) { expect_type("let", TYPE_PAIR, bindings); + /* printf("<>\n"); */ + /* pp(bindings); */ Value tr = transpose_2xn(bindings); Value params = car(tr), symargs = cadr(tr); + /* pp(symargs); */ Value proc = value_of_closure(*env, params, body); Value args = map_eval(env, symargs); + /* pp(args); */ Value letenv = *env; define_variable(&letenv, var, proc); return apply_closure(&letenv, proc, args);