From: Elijah Cohen <cohen@eli173.com>
Date: Sat, 17 Aug 2024 05:59:36 +0000 (+0000)
Subject: added bckw combinators
X-Git-Tag: v-12.13.14~32
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 <inttypes.h>
 #include <stdlib.h>
 
-#include <stdio.h>
 
 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)");
 }