From: Elijah Cohen <cohen@eli173.com>
Date: Sat, 17 Aug 2024 05:29:23 +0000 (+0000)
Subject: added SKI combinators
X-Git-Url: https://git.eli173.com/?a=commitdiff_plain;h=77d19ce97e7ee0a9d68dfc14df74e8ce061682ce;p=klapaucius

added SKI combinators
---

diff --git a/src/builtins.c b/src/builtins.c
index 5bef3b4..9641ea0 100644
--- 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
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
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 0a970b8..26ee2aa 100644
--- 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)");	
 }