added SKI combinators

diff --git a/src/builtins.c b/src/builtins.c
index 5bef3b417d1bd63cadac97b9193083e76b2d46f7..9641ea0238d1142508bc8d9450ff53615e3c0ccc 100644 (file)
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -9,6 +9,7 @@
 
 #include "builtins/core.h"
 #include "builtins/arithmetic.h"
+#include "builtins/combinators.h"
 
 #include <inttypes.h>
 #include <stdio.h>
@@ -21,6 +22,8 @@ Sexpr* dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
                return x_core_dispatch(b, rest, env);
        case ARITH_PREFIX:
                return x_arith_dispatch(b, rest, env);
+       case COMB_PREFIX:
+               return x_comb_dispatch(b, rest, env);
        default:
                return from_nil();
        }
@@ -53,6 +56,7 @@ Sexpr* load_env(Sexpr* env) {
        Sexpr* newenv = env;
        newenv = load_core_env(env);
        newenv = load_arith_env(newenv);
+       newenv = load_comb_env(newenv);
        //append_to_dict(env, from_sym("asdf"), from_uint(5455));
        return newenv;
 }

diff --git a/src/builtins/combinators.c b/src/builtins/combinators.c
new file mode 100644 (file)
index 0000000..a6bd0b3
--- /dev/null
+++ b/src/builtins/combinators.c
@@ -0,0 +1,92 @@
+
+#include "../types.h"
+#include "../builtins.h"
+#include "../sexpr.h"
+#include "../eval.h"
+#include "../dict.h"
+#include "combinators.h"
+
+#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)) {
+               return cons(b, rest);
+       }
+       Sexpr* args = b->value.b.args;
+       Sexpr* arg = clone(car(args));
+       sexpr_free(b);
+       return cons(arg, rest);
+}
+
+Sexpr* c_s(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       if(COMB_S_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* zclone = clone(z);
+       sexpr_free(b);
+       Sexpr* ret = cons(cons(y, cons(zclone, from_nil())), rest);
+       ret = cons(z, ret);
+       ret = cons(x, ret);
+       return ret;
+       // what lol
+}
+
+Sexpr* c_k(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       if(COMB_K_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)); // not needed
+       sexpr_free(b);
+       return cons(x, rest);
+}
+
+
+Sexpr* x_comb_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       uint64_t code = b->value.b.opcode & 0xff;
+
+       switch(code) {
+       case COMB_I:
+               return c_i(b, rest, env);
+       case COMB_S:
+               return c_s(b, rest, env);
+       case COMB_K:
+               return c_k(b, rest, env);
+       default:
+               return from_nil();
+       }
+       return from_nil();      
+}
+
+Sexpr* load_comb_env(Sexpr* env) {
+       Sexpr* k;
+       Sexpr* v;
+       
+       k = from_sym("I");
+       v = from_opcode((COMB_PREFIX << 8) | COMB_I);
+       append_to_dict(env, k, v);
+       sexpr_free(v);
+       sexpr_free(k);
+
+       k = from_sym("S");
+       v = from_opcode((COMB_PREFIX << 8) | COMB_S);
+       append_to_dict(env, k, v);
+       sexpr_free(v);
+       sexpr_free(k);
+
+       k = from_sym("K");
+       v = from_opcode((COMB_PREFIX << 8) | COMB_K);
+       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
new file mode 100644 (file)
index 0000000..6f018c8
--- /dev/null
+++ b/src/builtins/combinators.h
@@ -0,0 +1,20 @@
+#ifndef _B_COMB_H
+#define _B_COMB_H
+
+#include "../types.h"
+
+#define COMB_PREFIX 0x02
+
+#define COMB_I 0x00
+#define COMB_I_ARGS 1
+#define COMB_S 0x01
+#define COMB_S_ARGS 3
+#define COMB_K 0x02
+#define COMB_K_ARGS 2
+
+Sexpr* x_comb_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
+Sexpr* load_comb_env(Sexpr* env);
+
+
+
+#endif

diff --git a/src/test.c b/src/test.c
index 0a970b8d86318403a76442e561069e9dcfb277c6..26ee2aa25744fb2bc02c8d263c85239088b37a82 100644 (file)
--- a/src/test.c
+++ b/src/test.c
@@ -293,6 +293,13 @@ void eval_tests() {
        run_eval_test("(/ 100 20)");
        run_eval_test("(/ 100 21)");
        run_eval_test("(% 54 7)");
+
+       run_eval_test("(I + 4 5)");
+       run_eval_test("(S + (+ 4) 3)");
+       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)"); 
 }