From: Elijah Cohen <eli@eli173.com>
Date: Thu, 3 Oct 2024 21:52:35 +0000 (-0500)
Subject: far too much
X-Git-Url: https://git.eli173.com/?a=commitdiff_plain;h=89e52cc250cc2bb55469b2347af272ddd2498885;p=klapaucius

far too much

most important for future: will segfault for recursion as it stands,
need to find a way of going 'underneath' to evaluate things

but the changes are as follows:
added debugging functionality to print the builtins more clearly, and with their args.
required minimal changes in many places

but more importantly testing showed that I do have some sort of
working recursion, managed to implement a factorial function

still need to root around for any memory leaks from the new stuff
---

diff --git a/src/builtins.c b/src/builtins.c
index b775e85..c74cbad 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -107,3 +107,89 @@ Sexpr* load_env(Sexpr* env) {
 
 	return newenv;
 }
+
+
+char* lookup_builtin(Sexpr* b) {
+	// uh yeah i guess
+	// needs to be updated manually i suppose
+	uint64_t prefix = b->value.b.opcode >> 8;
+	uint64_t suffix = b->value.b.opcode & 0xff;
+	switch(prefix) {
+	case CORE_PREFIX:
+		switch(suffix) {
+		case CORE_QUOTE:
+			return CORE_QUOTE_STR;
+		case CORE_CONS:
+			return CORE_CONS_STR;
+		case CORE_CAR:
+			return CORE_CAR_STR;
+		case CORE_CDR:
+			return CORE_CDR_STR;
+		case CORE_IF:
+			return CORE_IF_STR;
+		case CORE_EQ:
+			return CORE_EQ_STR;
+		case CORE_NOT:
+			return CORE_NOT_STR;
+		case CORE_ATOM:
+			return CORE_ATOM_STR;
+		case CORE_DEF:
+			return CORE_DEF_STR;
+		case CORE_EXIT:
+			return CORE_EXIT_STR;
+		default:
+			return "NOT FOUND (CORE)";
+		}
+	case ARITH_PREFIX:
+		switch(suffix) {
+		case ARITH_ADD:
+			return ARITH_ADD_STR;
+		case ARITH_SUB:
+			return ARITH_SUB_STR;
+		case ARITH_MUL:
+			return ARITH_MUL_STR;
+		case ARITH_DIV:
+			return ARITH_DIV_STR;
+		case ARITH_MOD:
+			return ARITH_MOD_STR;
+		default:
+			return "NOT FOUND (ARITH)";
+		}
+	case COMB_PREFIX:
+		switch(suffix) {
+		case COMB_I:
+			return COMB_I_STR;
+		case COMB_S:
+			return COMB_S_STR;
+		case COMB_K:
+			return COMB_K_STR;
+		case COMB_B:
+			return COMB_B_STR;
+		case COMB_C:
+			return COMB_C_STR;
+		case COMB_W:
+			return COMB_W_STR;
+		case COMB_PHI:
+			return COMB_PHI_STR;
+		case COMB_PSI:
+			return COMB_PSI_STR;
+		case COMB_Z:
+			return COMB_Z_STR;
+		default:
+			return "NOT FOUND (COMB)";
+		}
+	case IO_PREFIX:
+		switch(suffix) {
+		case IO_PRINT:
+			return IO_PRINT_STR;
+		case IO_BPA:
+			return IO_BPA_STR;
+		default:
+			return "NOT FOUND (IO)";
+		}
+	default:
+		return "NOT FOUND";
+	}
+	return "NOT FOUND";
+}
+
diff --git a/src/builtins.h b/src/builtins.h
index fe03089..ecbbd51 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -11,4 +11,6 @@ uint64_t u64_get_num_args(Sexpr* b);
 void load_builtin(char* ks, uint64_t op, Sexpr* env);
 Sexpr* load_env(Sexpr* env);
 
+char* lookup_builtin(Sexpr* b);
+
 #endif
diff --git a/src/builtins/arithmetic.c b/src/builtins/arithmetic.c
index 6b21be0..c4692ee 100644
--- a/src/builtins/arithmetic.c
+++ b/src/builtins/arithmetic.c
@@ -108,11 +108,11 @@ Sexpr* x_arith_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
 }
 
 Sexpr* load_arith_env(Sexpr* env) {
-	load_builtin("+", (ARITH_PREFIX << 8) | ARITH_ADD, env);
-	load_builtin("-", (ARITH_PREFIX << 8) | ARITH_SUB, env);
-	load_builtin("*", (ARITH_PREFIX << 8) | ARITH_MUL, env);
-	load_builtin("/", (ARITH_PREFIX << 8) | ARITH_DIV, env);
-	load_builtin("%", (ARITH_PREFIX << 8) | ARITH_MOD, env);
+	load_builtin(ARITH_ADD_STR, (ARITH_PREFIX << 8) | ARITH_ADD, env);
+	load_builtin(ARITH_SUB_STR, (ARITH_PREFIX << 8) | ARITH_SUB, env);
+	load_builtin(ARITH_MUL_STR, (ARITH_PREFIX << 8) | ARITH_MUL, env);
+	load_builtin(ARITH_DIV_STR, (ARITH_PREFIX << 8) | ARITH_DIV, env);
+	load_builtin(ARITH_MOD_STR, (ARITH_PREFIX << 8) | ARITH_MOD, env);
 	
 	return env;
 }
diff --git a/src/builtins/arithmetic.h b/src/builtins/arithmetic.h
index 5706674..00900ce 100644
--- a/src/builtins/arithmetic.h
+++ b/src/builtins/arithmetic.h
@@ -8,14 +8,19 @@
 
 #define ARITH_ADD 0x00
 #define ARITH_ADD_ARGS 2
+#define ARITH_ADD_STR "+"
 #define ARITH_SUB 0x01
 #define ARITH_SUB_ARGS 2
+#define ARITH_SUB_STR "-"
 #define ARITH_MUL 0x02
 #define ARITH_MUL_ARGS 2
+#define ARITH_MUL_STR "*"
 #define ARITH_DIV 0x03
 #define ARITH_DIV_ARGS 2
+#define ARITH_DIV_STR "/"
 #define ARITH_MOD 0x04
 #define ARITH_MOD_ARGS 2
+#define ARITH_MOD_STR "%"
 
 Sexpr* x_arith_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
 Sexpr* load_arith_env(Sexpr* env);
diff --git a/src/builtins/combinators.c b/src/builtins/combinators.c
index af8f34e..cefc6dc 100644
--- a/src/builtins/combinators.c
+++ b/src/builtins/combinators.c
@@ -135,7 +135,8 @@ Sexpr* c_z(Sexpr* b, Sexpr* rest, Sexpr* env) {
 	Sexpr* z = from_opcode((COMB_PREFIX << 8) | COMB_Z);
 	Sexpr* zg = cons(z, cons(g2, from_nil()));
 	//return cons(g, rest);
-	return cons(g,cons(zg, cons(v, rest)));
+	Sexpr* toret = cons(g,cons(zg, cons(v, rest)));
+	return toret;
 }
 
 
@@ -170,15 +171,15 @@ Sexpr* x_comb_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
 }
 
 Sexpr* load_comb_env(Sexpr* env) {
-	load_builtin("I", (COMB_PREFIX << 8) | COMB_I, env);
-	load_builtin("S", (COMB_PREFIX << 8) | COMB_S, env);
-	load_builtin("K", (COMB_PREFIX << 8) | COMB_K, env);
-	load_builtin("B", (COMB_PREFIX << 8) | COMB_B, env);
-	load_builtin("C", (COMB_PREFIX << 8) | COMB_C, env);
-	load_builtin("W", (COMB_PREFIX << 8) | COMB_W, env);
-	load_builtin("Phi", (COMB_PREFIX << 8) | COMB_PHI, env);
-	load_builtin("Psi", (COMB_PREFIX << 8) | COMB_PSI, env);
-	load_builtin("Z", (COMB_PREFIX << 8) | COMB_Z, env);
+	load_builtin(COMB_I_STR, (COMB_PREFIX << 8) | COMB_I, env);
+	load_builtin(COMB_S_STR, (COMB_PREFIX << 8) | COMB_S, env);
+	load_builtin(COMB_K_STR, (COMB_PREFIX << 8) | COMB_K, env);
+	load_builtin(COMB_B_STR, (COMB_PREFIX << 8) | COMB_B, env);
+	load_builtin(COMB_C_STR, (COMB_PREFIX << 8) | COMB_C, env);
+	load_builtin(COMB_W_STR, (COMB_PREFIX << 8) | COMB_W, env);
+	load_builtin(COMB_PHI_STR, (COMB_PREFIX << 8) | COMB_PHI, env);
+	load_builtin(COMB_PSI_STR, (COMB_PREFIX << 8) | COMB_PSI, env);
+	load_builtin(COMB_Z_STR, (COMB_PREFIX << 8) | COMB_Z, env);
 	
 	return env;
 }
diff --git a/src/builtins/combinators.h b/src/builtins/combinators.h
index b64d7ec..da4af6e 100644
--- a/src/builtins/combinators.h
+++ b/src/builtins/combinators.h
@@ -7,22 +7,31 @@
 
 #define COMB_I 0x00
 #define COMB_I_ARGS 1
+#define COMB_I_STR "I"
 #define COMB_S 0x01
 #define COMB_S_ARGS 3
+#define COMB_S_STR "S"
 #define COMB_K 0x02
 #define COMB_K_ARGS 2
+#define COMB_K_STR "K"
 #define COMB_B 0x03
 #define COMB_B_ARGS 3
+#define COMB_B_STR "B"
 #define COMB_C 0x04
 #define COMB_C_ARGS 3
+#define COMB_C_STR "C"
 #define COMB_W 0x05
 #define COMB_W_ARGS 2
+#define COMB_W_STR "W"
 #define COMB_PHI 0x06
 #define COMB_PHI_ARGS 4
+#define COMB_PHI_STR "Phi"
 #define COMB_PSI 0x07
 #define COMB_PSI_ARGS 4
+#define COMB_PSI_STR "Psi"
 #define COMB_Z 0x08
 #define COMB_Z_ARGS 2
+#define COMB_Z_STR "Z"
 
 Sexpr* x_comb_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
 Sexpr* load_comb_env(Sexpr* env);
diff --git a/src/builtins/core.c b/src/builtins/core.c
index cec329e..084229f 100644
--- a/src/builtins/core.c
+++ b/src/builtins/core.c
@@ -212,17 +212,17 @@ Sexpr* x_core_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
 
 
 Sexpr* load_core_env(Sexpr* env) {
-	load_builtin("quote", (CORE_PREFIX << 8) | CORE_QUOTE, env);
-	load_builtin("cons", (CORE_PREFIX << 8) | CORE_CONS, env);
-	load_builtin("car", (CORE_PREFIX << 8) | CORE_CAR, env);
-	load_builtin("cdr", (CORE_PREFIX << 8) | CORE_CDR, env);
-	load_builtin("if", (CORE_PREFIX << 8) | CORE_IF, env);
-	load_builtin("eq", (CORE_PREFIX << 8) | CORE_EQ, env);
-	load_builtin("not", (CORE_PREFIX << 8) | CORE_NOT, env);
-	load_builtin("atom", (CORE_PREFIX << 8) | CORE_ATOM, env);
+	load_builtin(CORE_QUOTE_STR, (CORE_PREFIX << 8) | CORE_QUOTE, env);
+	load_builtin(CORE_CONS_STR, (CORE_PREFIX << 8) | CORE_CONS, env);
+	load_builtin(CORE_CAR_STR, (CORE_PREFIX << 8) | CORE_CAR, env);
+	load_builtin(CORE_CDR_STR, (CORE_PREFIX << 8) | CORE_CDR, env);
+	load_builtin(CORE_IF_STR, (CORE_PREFIX << 8) | CORE_IF, env);
+	load_builtin(CORE_EQ_STR, (CORE_PREFIX << 8) | CORE_EQ, env);
+	load_builtin(CORE_NOT_STR, (CORE_PREFIX << 8) | CORE_NOT, env);
+	load_builtin(CORE_ATOM_STR, (CORE_PREFIX << 8) | CORE_ATOM, env);
 	
-	load_builtin("def", (CORE_PREFIX << 8) | CORE_DEF, env);
-	load_builtin("exit", (CORE_PREFIX << 8) | CORE_EXIT, env);
+	load_builtin(CORE_DEF_STR, (CORE_PREFIX << 8) | CORE_DEF, env);
+	load_builtin(CORE_EXIT_STR, (CORE_PREFIX << 8) | CORE_EXIT, env);
 	
 	return env;
 }
diff --git a/src/builtins/core.h b/src/builtins/core.h
index 50606c7..0d6e8cc 100644
--- a/src/builtins/core.h
+++ b/src/builtins/core.h
@@ -10,28 +10,39 @@
 
 #define CORE_QUOTE 0x00
 #define CORE_QUOTE_ARGS 1
+#define CORE_QUOTE_STR "quote"
 #define CORE_CONS 0x01
 #define CORE_CONS_ARGS 2
+#define CORE_CONS_STR "cons"
 #define CORE_CAR 0x02
 #define CORE_CAR_ARGS 1
+#define CORE_CAR_STR "car"
 #define CORE_CDR 0x03
 #define CORE_CDR_ARGS 1
+#define CORE_CDR_STR "cdr"
 #define CORE_IF 0x04
 #define CORE_IF_ARGS 3
+#define CORE_IF_STR "if"
 #define CORE_EQ 0x05
 #define CORE_EQ_ARGS 2
+#define CORE_EQ_STR "eq"
 #define CORE_NOT 0x06
 #define CORE_NOT_ARGS 1
+#define CORE_NOT_STR "not"
 #define CORE_ATOM 0x07
 #define CORE_ATOM_ARGS 1
+#define CORE_ATOM_STR "atom"
 
 #define CORE_APPLYN 0x08
 #define CORE_APPLYN_ARGS 3
+#define CORE_APPLYN_STR "applyn"
 
 #define CORE_DEF 0xfe // huh do i want this so close to exit?
 #define CORE_DEF_ARGS 2
+#define CORE_DEF_STR "def"
 #define CORE_EXIT 0xff
 #define CORE_EXIT_ARGS 1
+#define CORE_EXIT_STR "exit"
 
 Sexpr* x_core_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
 Sexpr* load_core_env(Sexpr* env);
diff --git a/src/builtins/io.c b/src/builtins/io.c
index fd9ff06..36178c7 100644
--- a/src/builtins/io.c
+++ b/src/builtins/io.c
@@ -5,6 +5,7 @@
 #include "../sexpr.h"
 #include "../config.h"
 #include "io.h"
+#include "../eval.h"
 
 #include <stdlib.h>
 #include <inttypes.h>
@@ -22,6 +23,21 @@ Sexpr* io_print(Sexpr* b, Sexpr* rest, Sexpr* env) {
 	return cons(from_t(), rest);
 }
 
+Sexpr* io_print_b(Sexpr* b, Sexpr* rest, Sexpr* env) {
+	if(IO_PB_ARGS != u64_get_num_args(b)) {
+		return cons(b, rest);
+	}
+	Sexpr* arg = clone(car(b->value.b.args));
+	sexpr_free(b);
+	Sexpr* argeval = eval(arg, env);
+	char* out = sprint_sexpr_builtin(argeval);
+	sexpr_free(argeval);
+	// uhh do i free arg? don't think so...
+	PRINT(out);
+	free(out);
+	return cons(from_t(), rest);
+}
+
 
 Sexpr* x_io_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
 	uint64_t code = b->value.b.opcode & 0xff;
@@ -29,6 +45,8 @@ Sexpr* x_io_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
 	switch(code) {
 	case IO_PRINT:
 		return io_print(b, rest, env);
+	case IO_PB:
+		return io_print_b(b, rest, env);
 	default:
 		return from_nil();
 	}
@@ -36,7 +54,8 @@ Sexpr* x_io_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
 }
 
 Sexpr* load_io_env(Sexpr* env) {
-	load_builtin("print", (IO_PREFIX << 8) | IO_PRINT, env);
+	load_builtin(IO_PRINT_STR, (IO_PREFIX << 8) | IO_PRINT, env);
+	load_builtin(IO_PB_STR, (IO_PREFIX << 8) | IO_PB, env);
 
 	return env;
 }
diff --git a/src/builtins/io.h b/src/builtins/io.h
index 2cb627e..89fc7cc 100644
--- a/src/builtins/io.h
+++ b/src/builtins/io.h
@@ -7,6 +7,10 @@
 
 #define IO_PRINT 0x00
 #define IO_PRINT_ARGS 1
+#define IO_PRINT_STR "print"
+#define IO_PB 0x01
+#define IO_PB_ARGS 1
+#define IO_PB_STR "pb"
 
 Sexpr* x_io_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
 Sexpr* load_io_env(Sexpr* env);
diff --git a/src/eval.c b/src/eval.c
index 70325b2..18870ef 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -10,8 +10,8 @@
 Sexpr* apply_builtin(Sexpr* func, Sexpr* arg, Sexpr* env);
 
 Sexpr* eval(Sexpr* s, Sexpr* dict) {
-	/* char* out = sprint_sexpr(s);
-	printf("s: %s\n", out);
+	/* char* out = sprint_sexpr_builtin(s);
+	PRINT(out);
 	free(out); */
 	// okay.. important to note,
 	// this needs to free s
diff --git a/src/sexpr.c b/src/sexpr.c
index 7d37562..1114ea0 100644
--- a/src/sexpr.c
+++ b/src/sexpr.c
@@ -7,6 +7,7 @@
 
 #include "types.h"
 #include "sexpr.h"
+#include "builtins.h"
 
 
 Sexpr* from_nil() {
@@ -222,7 +223,7 @@ char* sprint_sexpr(Sexpr* s) {
 		out = malloc(nbytes*sizeof(char));
 		out[0] = '_';
 		snprintf(out + 1, nbytes, "%" PRIu64 "", s->value.b.opcode);
-		return out;		
+		return out;
 	}
 	else if(s->type == QUOTE) {
 		return sprint_sexpr(s->value.q);
@@ -260,3 +261,90 @@ char* sprint_sexpr(Sexpr* s) {
 	}
 	return NULL;
 }
+
+char* sprint_sexpr_builtin(Sexpr* s) {
+	if(s == NULL) {
+		WARN("UH OH IT'S NULL", "");
+		return NULL;
+	}
+	// assumes not null
+	size_t nbytes;
+	char* out;
+	if(s->type == NIL) {
+ 		out = malloc(4*sizeof(char));
+		strcpy(out, "nil");
+		return out;
+	}
+	else if(s->type == T) {
+		out = malloc(2*sizeof(char));
+		strcpy(out, "t");
+		return out;
+	}
+	else if(s->type == SYM) {
+		out = malloc(sizeof(char)*(strlen(s->value.s)+1));
+		strcpy(out, s->value.s);
+		return out;
+	}
+	else if(s->type == PTR) {
+		out = strdup("<*>");
+		return out;
+	}
+	else if(s->type == UINT) {
+		nbytes = snprintf(NULL, 0, "%" K_UINT_PRINT "", s->value.u) + 1;
+		out = malloc(nbytes*sizeof(char));
+		snprintf(out, nbytes, "%" PRIu64 "", s->value.u);
+		return out;
+	}
+	else if(s->type == BUILTIN) {
+		nbytes = snprintf(NULL, 0, "%s", lookup_builtin(s))+2;
+		//nbytes = snprintf(NULL, 0, "%" PRIu64 "", s->value.b.opcode) + 2;
+		out = malloc(nbytes*sizeof(char));
+		out[0] = '_';
+		snprintf(out  + 1, nbytes, "%s", lookup_builtin(s));
+		//snprintf(out  + 1, nbytes, "%" PRIu64 "", s->value.b.opcode);
+		out[nbytes-1] = '<';
+		//out[nbytes] = '\0';
+		char* rest = sprint_sexpr_builtin(s->value.b.args);
+		out = realloc(out, nbytes + strlen(rest) + 2);
+		strcpy(out+nbytes, rest);
+		out[nbytes+strlen(rest)] = '>';
+		out[nbytes+strlen(rest)+1] = '\0';
+		free(rest);
+		return out;
+	}
+	else if(s->type == QUOTE) {
+		return sprint_sexpr_builtin(s->value.q);
+	}
+	else if(s->type == CONS) {
+		Sexpr* curr_cell = s;
+		size_t currsize = 2;
+		out = malloc(currsize*sizeof(char));
+		out[0] = '(';
+		out[1] = '\0';
+		while(curr_cell->type == CONS) {
+			char* carstr = sprint_sexpr_builtin(car(curr_cell));
+			currsize += strlen(carstr) + 1; // trailing space/close paren
+			out = realloc(out, currsize);
+			strcat(out, carstr);
+			free(carstr);
+			strcat(out, " ");
+			curr_cell = cdr(curr_cell);
+		}
+		if(curr_cell->type == NIL) {
+			out[currsize-2] = ')';
+			out[currsize-1] = '\0';
+			return out;
+		}
+		else { // non-nil
+			char* cdrstr = sprint_sexpr_builtin(curr_cell);
+			currsize += strlen(cdrstr) + 4; // dot, space, close, null-terminator
+			strcat(out, ". ");
+			strcat(out, cdrstr);
+			strcat(out, ")");
+			out[currsize-1] = '\0';
+			free(cdrstr);
+			return out;
+		}
+	}
+	return NULL;
+}
diff --git a/src/sexpr.h b/src/sexpr.h
index 79c5e18..a3ff2cc 100644
--- a/src/sexpr.h
+++ b/src/sexpr.h
@@ -21,5 +21,6 @@ Sexpr* cdr(Sexpr* s);
 Sexpr* reverse(Sexpr* s);
 Sexpr* equal(Sexpr* a, Sexpr* b);
 char* sprint_sexpr(Sexpr* s);
+char* sprint_sexpr_builtin(Sexpr* s);
 
 #endif