added bckw combinators

diff --git a/src/builtins/combinators.c b/src/builtins/combinators.c
index a6bd0b35ab450c03a07c94f93b9c7f8ac30289ff..b9d1ac963e5b77aacb21e6692a14ca879d565605 100644 (file)
--- 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 6f018c8372bc731874b402a1fd25055405cf350e..9b8cb324d12b7bfcdec625cf0a40d93f618dae86 100644 (file)
--- 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 26ee2aa25744fb2bc02c8d263c85239088b37a82..3ed70c3cd7d9f2e5d28daae971b58580914f696a 100644 (file)
--- 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)");
 }