From 26de8f0ccc0e9f822f566c78df7854e9de40a395 Mon Sep 17 00:00:00 2001 From: Tadashi Saito Date: Thu, 18 Jul 2024 22:52:49 +0900 Subject: [PATCH 1/5] All definition functions take environment argument. --- lisp.c | 98 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 53 insertions(+), 45 deletions(-) diff --git a/lisp.c b/lisp.c index 57a9111..3f25e13 100644 --- a/lisp.c +++ b/lisp.c @@ -555,7 +555,7 @@ static void expect_arity(long expected, long actual) expected, actual); } -Value apply(Value func, Value vargs) +Value apply(Value func, Value vargs, Value env) { static const long ARG_MAX = 7; @@ -573,23 +573,23 @@ Value apply(Value func, Value vargs) CFunc f = FUNCTION(func)->cfunc; switch (n) { case -1: - return (*f)(vargs); + return (*f)(env, vargs); case 0: - return (*f)(); + return (*f)(env); case 1: - return (*f)(a[0]); + return (*f)(env, a[0]); case 2: - return (*f)(a[0], a[1]); + return (*f)(env, a[0], a[1]); case 3: - return (*f)(a[0], a[1], a[2]); + return (*f)(env, a[0], a[1], a[2]); case 4: - return (*f)(a[0], a[1], a[2], a[3]); + return (*f)(env, a[0], a[1], a[2], a[3]); case 5: - return (*f)(a[0], a[1], a[2], a[3], a[4]); + return (*f)(env, a[0], a[1], a[2], a[3], a[4]); case 6: - return (*f)(a[0], a[1], a[2], a[3], a[4], a[5]); + return (*f)(env, a[0], a[1], a[2], a[3], a[4], a[5]); case 7: - return (*f)(a[0], a[1], a[2], a[3], a[4], a[5], a[6]); + return (*f)(env, a[0], a[1], a[2], a[3], a[4], a[5], a[6]); default: UNREACHABLE(); } @@ -655,25 +655,25 @@ static Value alist_put_or_append(Value l, Value vkey, Value val) return l; } -static Value env_put(Value name, Value val) +static Value env_put(Value *env, Value name, Value val) { - default_environment = alist_put_or_append(default_environment, name, val); + *env = alist_put_or_append(*env, name, val); return name; } -static Value define_special(const char *name, CFunc cfunc, long arity) +static Value define_special(Value *env, const char *name, CFunc cfunc, long arity) { - return env_put(value_of_symbol(name), value_of_special(cfunc, arity)); + return env_put(env, value_of_symbol(name), value_of_special(cfunc, arity)); } -static Value define_function(const char *name, CFunc cfunc, long arity) +static Value define_function(Value *env, const char *name, CFunc cfunc, long arity) { - return env_put(value_of_symbol(name), value_of_func(cfunc, arity)); + return env_put(env, value_of_symbol(name), value_of_func(cfunc, arity)); } -static Value lookup(Value name) +static Value lookup(Value env, Value name) { - return alist_find(default_environment, name); + return alist_find(env, name); } Value eval_string(const char *in) @@ -693,27 +693,34 @@ static Value memq(Value needle, Value list) return Qnil; } -static Value eval_funcy(Value list) +static Value ieval(Value v, Value env); // internal + +static Value eval_funcy(Value list, Value env) { - Value f = eval(car(list)); + Value f = ieval(car(list), env); if (f == Qundef) return Qundef; Value args = cdr(list); if (tagged_value_is(f, TAG_SPECIAL)) - return apply(f, args); + return apply(f, args, env); Value l = map(eval, args); if (memq(Qundef, l) != Qnil) return Qundef; - return apply(f, l); + return apply(f, l, env); } -Value eval(Value v) +static Value ieval(Value v, Value env) { if (value_is_symbol(v)) - return lookup(v); + return lookup(env, v); if (v == Qnil || is_immediate(v) || value_is_string(v)) return v; - return eval_funcy(v); + return eval_funcy(v, env); +} + +Value eval(Value v) +{ + return ieval(v, default_environment); } Value load(FILE *in) @@ -846,7 +853,7 @@ static void expect_type(Type expected, Value v, const char *header) header, delim, TYPE_NAMES[expected], TYPE_NAMES[t]); } -static Value builtin_add(Value args) +static Value builtin_add(ATTR_UNUSED Value env, Value args) { int64_t y = 0; for (Value l = args; l != Qnil; l = cdr(l)) { @@ -857,7 +864,7 @@ static Value builtin_add(Value args) return value_of_int(y); } -static Value builtin_sub(Value args) +static Value builtin_sub(ATTR_UNUSED Value env, Value args) { if (args == Qnil) error("wrong number of arguments: expected 1 or more but got 0"); @@ -878,7 +885,7 @@ static Value builtin_sub(Value args) return value_of_int(y); } -static Value builtin_mul(Value args) +static Value builtin_mul(ATTR_UNUSED Value env, Value args) { int64_t y = 1; for (Value l = args; l != Qnil; l = cdr(l)) { @@ -889,7 +896,7 @@ static Value builtin_mul(Value args) return value_of_int(y); } -static Value builtin_div(Value args) +static Value builtin_div(ATTR_UNUSED Value env, Value args) { if (args == Qnil) error("wrong number of arguments: expected 1 or more but got 0"); @@ -916,27 +923,27 @@ static bool validate_arity_range(Value args, long min, long max) return min <= l && l <= max; } -static Value builtin_if(Value args) +static Value builtin_if(Value env, Value args) { if (!validate_arity_range(args, 2, 3)) return Qundef; Value cond = car(args), then = cadr(args); - if (eval(cond) != Qfalse) - return eval(then); + if (ieval(cond, env) != Qfalse) + return ieval(then, env); Value els = cddr(args); if (els == Qnil) return Qfalse; - return eval(car(els)); + return ieval(car(els), env); } -static Value builtin_define(Value ident, Value expr) +static Value builtin_define(Value env, Value ident, Value expr) { expect_type(TYPE_SYMBOL, ident, "define"); - Value val = eval(expr); - if (val == Qundef) + Value val = ieval(expr, env); + if (val == Qundef) return Qundef; - return env_put(ident, val); + return env_put(&env, ident, val); } static Value builtin_list(Value args) @@ -947,13 +954,14 @@ static Value builtin_list(Value args) ATTR_CTOR static void initialize(void) { - define_special("if", builtin_if, -1); - define_special("define", builtin_define, 2); + Value *e = &default_environment; + define_special(e, "if", builtin_if, -1); + define_special(e, "define", builtin_define, 2); - define_function("+", builtin_add, -1); - define_function("-", builtin_sub, -1); - define_function("*", builtin_mul, -1); - define_function("/", builtin_div, -1); - define_function("list", builtin_list, -1); - define_function("reverse", reverse, 1); + define_function(e, "+", builtin_add, -1); + define_function(e, "-", builtin_sub, -1); + define_function(e, "*", builtin_mul, -1); + define_function(e, "/", builtin_div, -1); + define_function(e, "list", builtin_list, -1); + define_function(e, "reverse", reverse, 1); } From 85259a315fe780830d421c184a74735ce423c859 Mon Sep 17 00:00:00 2001 From: Tadashi Saito Date: Fri, 19 Jul 2024 12:27:30 +0900 Subject: [PATCH 2/5] Provide env argument only for special forms. --- lisp.c | 42 +++++++++++++++++++++++++++--------------- 1 file changed, 27 insertions(+), 15 deletions(-) diff --git a/lisp.c b/lisp.c index 3f25e13..a39ab0d 100644 --- a/lisp.c +++ b/lisp.c @@ -549,7 +549,7 @@ long length(Value list) static void expect_arity(long expected, long actual) { - if (expected == -1 || expected == actual) + if (expected < 0 || expected == actual) return; error("wrong number of arguments: expected %ld but got %ld", expected, actual); @@ -572,29 +572,41 @@ Value apply(Value func, Value vargs, Value env) } CFunc f = FUNCTION(func)->cfunc; switch (n) { + case -2: + return (*f)(env, cdr(vargs)); // special form case -1: - return (*f)(env, vargs); + return (*f)(vargs); // non-special case 0: - return (*f)(env); + return (*f)(); case 1: - return (*f)(env, a[0]); + return (*f)(a[0]); case 2: - return (*f)(env, a[0], a[1]); + return (*f)(a[0], a[1]); case 3: - return (*f)(env, a[0], a[1], a[2]); + return (*f)(a[0], a[1], a[2]); case 4: - return (*f)(env, a[0], a[1], a[2], a[3]); + return (*f)(a[0], a[1], a[2], a[3]); case 5: - return (*f)(env, a[0], a[1], a[2], a[3], a[4]); + return (*f)(a[0], a[1], a[2], a[3], a[4]); case 6: - return (*f)(env, a[0], a[1], a[2], a[3], a[4], a[5]); + return (*f)(a[0], a[1], a[2], a[3], a[4], a[5]); case 7: - return (*f)(env, a[0], a[1], a[2], a[3], a[4], a[5], a[6]); + return (*f)(a[0], a[1], a[2], a[3], a[4], a[5], a[6]); default: UNREACHABLE(); } } +static Value apply_special(Value sp, Value vargs, Value env) +{ + Function f = *FUNCTION(sp); + if (f.arity == -1) + f.arity = -2; // only for special forms + else + f.arity++; + return apply((Value) &f, cons(env, vargs), env); +} + typedef Value (*FuncMapper)(Value); static Value map(FuncMapper f, Value l) @@ -702,7 +714,7 @@ static Value eval_funcy(Value list, Value env) return Qundef; Value args = cdr(list); if (tagged_value_is(f, TAG_SPECIAL)) - return apply(f, args, env); + return apply_special(f, args, env); Value l = map(eval, args); if (memq(Qundef, l) != Qnil) return Qundef; @@ -853,7 +865,7 @@ static void expect_type(Type expected, Value v, const char *header) header, delim, TYPE_NAMES[expected], TYPE_NAMES[t]); } -static Value builtin_add(ATTR_UNUSED Value env, Value args) +static Value builtin_add(Value args) { int64_t y = 0; for (Value l = args; l != Qnil; l = cdr(l)) { @@ -864,7 +876,7 @@ static Value builtin_add(ATTR_UNUSED Value env, Value args) return value_of_int(y); } -static Value builtin_sub(ATTR_UNUSED Value env, Value args) +static Value builtin_sub(Value args) { if (args == Qnil) error("wrong number of arguments: expected 1 or more but got 0"); @@ -885,7 +897,7 @@ static Value builtin_sub(ATTR_UNUSED Value env, Value args) return value_of_int(y); } -static Value builtin_mul(ATTR_UNUSED Value env, Value args) +static Value builtin_mul(Value args) { int64_t y = 1; for (Value l = args; l != Qnil; l = cdr(l)) { @@ -896,7 +908,7 @@ static Value builtin_mul(ATTR_UNUSED Value env, Value args) return value_of_int(y); } -static Value builtin_div(ATTR_UNUSED Value env, Value args) +static Value builtin_div(Value args) { if (args == Qnil) error("wrong number of arguments: expected 1 or more but got 0"); From 7e856d2afab9b70144d911bea38b405244e89ba4 Mon Sep 17 00:00:00 2001 From: Tadashi Saito Date: Fri, 19 Jul 2024 12:31:54 +0900 Subject: [PATCH 3/5] Refactoring: reorder env argument position. --- lisp.c | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/lisp.c b/lisp.c index a39ab0d..29ee647 100644 --- a/lisp.c +++ b/lisp.c @@ -555,7 +555,7 @@ static void expect_arity(long expected, long actual) expected, actual); } -Value apply(Value func, Value vargs, Value env) +Value apply(Value env, Value func, Value vargs) { static const long ARG_MAX = 7; @@ -597,14 +597,14 @@ Value apply(Value func, Value vargs, Value env) } } -static Value apply_special(Value sp, Value vargs, Value env) +static Value apply_special(Value env, Value sp, Value vargs) { Function f = *FUNCTION(sp); if (f.arity == -1) f.arity = -2; // only for special forms else f.arity++; - return apply((Value) &f, cons(env, vargs), env); + return apply(env, (Value) &f, cons(env, vargs)); } typedef Value (*FuncMapper)(Value); @@ -705,34 +705,34 @@ static Value memq(Value needle, Value list) return Qnil; } -static Value ieval(Value v, Value env); // internal +static Value ieval(Value env, Value v); // internal -static Value eval_funcy(Value list, Value env) +static Value eval_funcy(Value env, Value list) { - Value f = ieval(car(list), env); + Value f = ieval(env, car(list)); if (f == Qundef) return Qundef; Value args = cdr(list); if (tagged_value_is(f, TAG_SPECIAL)) - return apply_special(f, args, env); + return apply_special(env, f, args); Value l = map(eval, args); if (memq(Qundef, l) != Qnil) return Qundef; - return apply(f, l, env); + return apply(env, f, l); } -static Value ieval(Value v, Value env) +static Value ieval(Value env, Value v) { if (value_is_symbol(v)) return lookup(env, v); if (v == Qnil || is_immediate(v) || value_is_string(v)) return v; - return eval_funcy(v, env); + return eval_funcy(env, v); } Value eval(Value v) { - return ieval(v, default_environment); + return ieval(default_environment, v); } Value load(FILE *in) @@ -941,18 +941,18 @@ static Value builtin_if(Value env, Value args) return Qundef; Value cond = car(args), then = cadr(args); - if (ieval(cond, env) != Qfalse) - return ieval(then, env); + if (ieval(env, cond) != Qfalse) + return ieval(env, then); Value els = cddr(args); if (els == Qnil) return Qfalse; - return ieval(car(els), env); + return ieval(env, car(els)); } static Value builtin_define(Value env, Value ident, Value expr) { expect_type(TYPE_SYMBOL, ident, "define"); - Value val = ieval(expr, env); + Value val = ieval(env, expr); if (val == Qundef) return Qundef; return env_put(&env, ident, val); From 1b738b1f06eeb007ab0742dd41ad1d416e61cfad Mon Sep 17 00:00:00 2001 From: Tadashi Saito Date: Fri, 19 Jul 2024 14:09:54 +0900 Subject: [PATCH 4/5] Refactoring. --- lisp.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/lisp.c b/lisp.c index 29ee647..224dd18 100644 --- a/lisp.c +++ b/lisp.c @@ -599,12 +599,7 @@ Value apply(Value env, Value func, Value vargs) static Value apply_special(Value env, Value sp, Value vargs) { - Function f = *FUNCTION(sp); - if (f.arity == -1) - f.arity = -2; // only for special forms - else - f.arity++; - return apply(env, (Value) &f, cons(env, vargs)); + return apply(env, sp, cons(env, vargs)); } typedef Value (*FuncMapper)(Value); @@ -675,6 +670,7 @@ static Value env_put(Value *env, Value name, Value val) static Value define_special(Value *env, const char *name, CFunc cfunc, long arity) { + arity += (arity == -1) ? -1 : 1; return env_put(env, value_of_symbol(name), value_of_special(cfunc, arity)); } From d921d1f12094bbeb7618f8f8aabb9a19d5a59d2e Mon Sep 17 00:00:00 2001 From: Tadashi Saito Date: Fri, 19 Jul 2024 14:16:33 +0900 Subject: [PATCH 5/5] Ensure to use ieval, not eval. --- lisp.c | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lisp.c b/lisp.c index 224dd18..26438e0 100644 --- a/lisp.c +++ b/lisp.c @@ -602,19 +602,6 @@ static Value apply_special(Value env, Value sp, Value vargs) return apply(env, sp, cons(env, vargs)); } -typedef Value (*FuncMapper)(Value); - -static Value map(FuncMapper f, Value l) -{ - Value mapped = Qnil, last = Qnil; - for (; l != Qnil; l = cdr(l)) { - last = append(last, f(car(l))); - if (mapped == Qnil) - mapped = last; - } - return mapped; -} - static Value default_environment = Qnil; // alist of ('ident . ) static Value alist_find_or_last(Value l, Value vkey, Value *last) @@ -703,6 +690,19 @@ static Value memq(Value needle, Value list) static Value ieval(Value env, Value v); // internal +typedef Value (*MapFunc)(Value common, Value v); +static Value map2(MapFunc f, Value common, Value l) +{ + Value mapped = Qnil, last = Qnil; + for (; l != Qnil; l = cdr(l)) { + last = append(last, f(common, car(l))); + if (mapped == Qnil) + mapped = last; + } + return mapped; +} + + static Value eval_funcy(Value env, Value list) { Value f = ieval(env, car(list)); @@ -711,7 +711,7 @@ static Value eval_funcy(Value env, Value list) Value args = cdr(list); if (tagged_value_is(f, TAG_SPECIAL)) return apply_special(env, f, args); - Value l = map(eval, args); + Value l = map2(ieval, env, args); if (memq(Qundef, l) != Qnil) return Qundef; return apply(env, f, l); @@ -728,7 +728,8 @@ static Value ieval(Value env, Value v) Value eval(Value v) { - return ieval(default_environment, v); + Value env = default_environment; + return ieval(env, v); } Value load(FILE *in)