From: Elijah Cohen Date: Sat, 17 Aug 2024 05:59:36 +0000 (+0000) Subject: added bckw combinators X-Git-Url: https://git.eli173.com/?a=commitdiff_plain;h=babf9d85cb222c6c79fafbbece98313270c02d73;p=klapaucius added bckw combinators --- diff --git a/src/builtins/combinators.c b/src/builtins/combinators.c index a6bd0b3..b9d1ac9 100644 --- a/src/builtins/combinators.c +++ b/src/builtins/combinators.c @@ -9,7 +9,6 @@ #include #include -#include Sexpr* c_i(Sexpr* b, Sexpr* rest, Sexpr* env) { if(COMB_I_ARGS != u64_get_num_args(b)) { @@ -49,6 +48,47 @@ Sexpr* c_k(Sexpr* b, Sexpr* rest, Sexpr* env) { return cons(x, rest); } +Sexpr* c_b(Sexpr* b, Sexpr* rest, Sexpr* env) { + if(COMB_B_ARGS != u64_get_num_args(b)) { + return cons(b, rest); + } + Sexpr* args = b->value.b.args; + Sexpr* x = clone(car(cdr(cdr(args)))); + Sexpr* y = clone(car(cdr(args))); + Sexpr* z = clone(car(args)); + sexpr_free(b); + + Sexpr* ret = cons(x, cons(cons(y, cons(z, from_nil())), rest)); + return ret; +} + +Sexpr* c_c(Sexpr* b, Sexpr* rest, Sexpr* env) { + if(COMB_C_ARGS != u64_get_num_args(b)) { + return cons(b, rest); + } + Sexpr* args = b->value.b.args; + Sexpr* x = clone(car(cdr(cdr(args)))); + Sexpr* y = clone(car(cdr(args))); + Sexpr* z = clone(car(args)); + sexpr_free(b); + + Sexpr* ret = cons(x, cons(z, cons(y, rest))); + return ret; +} + +Sexpr* c_w(Sexpr* b, Sexpr* rest, Sexpr* env) { + if(COMB_W_ARGS != u64_get_num_args(b)) { + return cons(b, rest); + } + Sexpr* args = b->value.b.args; + Sexpr* x = clone(car(cdr(args))); + Sexpr* y = clone(car(args)); + Sexpr* y2 = clone(y); + sexpr_free(b); + Sexpr* ret = cons(x, cons(y, cons(y2, rest))); + return ret; +} + Sexpr* x_comb_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) { uint64_t code = b->value.b.opcode & 0xff; @@ -60,6 +100,12 @@ Sexpr* x_comb_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) { return c_s(b, rest, env); case COMB_K: return c_k(b, rest, env); + case COMB_B: + return c_b(b, rest, env); + case COMB_C: + return c_c(b, rest, env); + case COMB_W: + return c_w(b, rest, env); default: return from_nil(); } @@ -87,6 +133,24 @@ Sexpr* load_comb_env(Sexpr* env) { append_to_dict(env, k, v); sexpr_free(v); sexpr_free(k); - + + k = from_sym("B"); + v = from_opcode((COMB_PREFIX << 8) | COMB_B); + append_to_dict(env, k, v); + sexpr_free(v); + sexpr_free(k); + + k = from_sym("C"); + v = from_opcode((COMB_PREFIX << 8) | COMB_C); + append_to_dict(env, k, v); + sexpr_free(v); + sexpr_free(k); + + k = from_sym("W"); + v = from_opcode((COMB_PREFIX << 8) | COMB_W); + append_to_dict(env, k, v); + sexpr_free(v); + sexpr_free(k); + return env; } diff --git a/src/builtins/combinators.h b/src/builtins/combinators.h index 6f018c8..9b8cb32 100644 --- a/src/builtins/combinators.h +++ b/src/builtins/combinators.h @@ -11,6 +11,12 @@ #define COMB_S_ARGS 3 #define COMB_K 0x02 #define COMB_K_ARGS 2 +#define COMB_B 0x03 +#define COMB_B_ARGS 3 +#define COMB_C 0x04 +#define COMB_C_ARGS 3 +#define COMB_W 0x05 +#define COMB_W_ARGS 2 Sexpr* x_comb_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env); Sexpr* load_comb_env(Sexpr* env); diff --git a/src/test.c b/src/test.c index 26ee2aa..3ed70c3 100644 --- a/src/test.c +++ b/src/test.c @@ -299,7 +299,10 @@ void eval_tests() { run_eval_test("(K 5 6)"); run_eval_test("(S K I 5)"); run_eval_test("(S K I K 1 2)"); - run_eval_test("(K S (I (S K S I)) + (+ 4) 3)"); + run_eval_test("(K S (I (S K S I)) + (+ 4) 3)"); + run_eval_test("(B car cdr (quote (1 2 3)))"); + run_eval_test("(C - 3 10)"); + run_eval_test("(W * 5)"); }