From babf9d85cb222c6c79fafbbece98313270c02d73 Mon Sep 17 00:00:00 2001
From: Elijah Cohen <cohen@eli173.com>
Date: Sat, 17 Aug 2024 05:59:36 +0000
Subject: [PATCH] added bckw combinators
---
src/builtins/combinators.c | 68 ++++++++++++++++++++++++++++++++++++--
src/builtins/combinators.h | 6 ++++
src/test.c | 5 ++-
3 files changed, 76 insertions(+), 3 deletions(-)
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)");
}
--
2.39.5