From 77d19ce97e7ee0a9d68dfc14df74e8ce061682ce Mon Sep 17 00:00:00 2001
From: Elijah Cohen <cohen@eli173.com>
Date: Sat, 17 Aug 2024 05:29:23 +0000
Subject: [PATCH] added SKI combinators
---
src/builtins.c | 4 ++
src/builtins/combinators.c | 92 ++++++++++++++++++++++++++++++++++++++
src/builtins/combinators.h | 20 +++++++++
src/test.c | 7 +++
4 files changed, 123 insertions(+)
create mode 100644 src/builtins/combinators.c
create mode 100644 src/builtins/combinators.h
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)");
}
--
2.39.5