From: Elijah Cohen <eli@eli173.com>
Date: Sun, 3 Nov 2024 05:15:46 +0000 (-0500)
Subject: some very basic string things
X-Git-Tag: v-12.13.14~13
X-Git-Url: https://git.eli173.com/?a=commitdiff_plain;h=3d068237de6a8008ef28f8fefc71ccc300edb075;p=klapaucius

some very basic string things
---

diff --git a/demos.kl b/demos.kl
index a1da106..6514650 100644
--- a/demos.kl
+++ b/demos.kl
@@ -2,6 +2,11 @@
 
 (def D (B B))
 
+(def and (B W (B C) I))
+(def or (S I I))
+(def not (B C (C I) nil t))
+(def xor (C (C Phi not) I))
+(def zerop (B C (C I) (t nil) t))
 
 (def fac (Z (D S (C (eq 0) 1) (D S * (C B (C - 1))))))
 
@@ -11,7 +16,7 @@
 
 (def nth (B (B car) (B (C I cdr) (C - 1))))
 
-(def list (rest I))
+(def list (rest (map unquote)))
 
 (def len (B (Z (B (S (S (B (eq nil) cdr) car)) (C B (CC (+ 1) cdr)))) (cons 0)))
 
diff --git a/src/builtins.c b/src/builtins.c
index 5239e8e..c38a0c9 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -10,6 +10,7 @@
 #include "builtins/arithmetic.h"
 #include "builtins/combinators.h"
 #include "builtins/io.h"
+#include "builtins/strings.h"
 
 #include <inttypes.h>
 
@@ -25,6 +26,8 @@ Sexpr* dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
 		return x_comb_dispatch(b, rest, env);
 	case IO_PREFIX:
 		return x_io_dispatch(b, rest, env);
+	case STRINGS_PREFIX:
+		return x_strings_dispatch(b, rest, env);
 	default:
 		return from_nil();
 	}
@@ -111,6 +114,7 @@ Sexpr* load_env(Sexpr* env) {
 	newenv = load_arith_env(newenv);
 	newenv = load_comb_env(newenv);
 	newenv = load_io_env(newenv);
+	newenv = load_strings_env(newenv);
 
 	return newenv;
 }
diff --git a/src/builtins/core.c b/src/builtins/core.c
index fdc1736..71ae600 100644
--- a/src/builtins/core.c
+++ b/src/builtins/core.c
@@ -10,7 +10,6 @@
 #include <inttypes.h>
 #include <stdlib.h>
 
-#include <stdio.h>
 
 Sexpr* c_quote(Sexpr* b, Sexpr* rest, Sexpr* env) {
 	if(CORE_QUOTE_ARGS != u64_get_num_args(b))
@@ -166,10 +165,11 @@ Sexpr* c_unquote(Sexpr* b, Sexpr* rest, Sexpr* env) {
 	// now the question here is, is it necessarily wrong
 	// to do this to non-quotes?
 	// this... needs an eval...
+	// huh this might need a weird cursed double-eval
 	if(CORE_UNQUOTE_ARGS != u64_get_num_args(b))
 		return cons(b, rest);
-	Sexpr* first_arg = car(b->value.b.args);
-	Sexpr* newthing = eval(clone(unquote(first_arg)), env);
+	Sexpr* first_arg = eval(clone(car(b->value.b.args)), env);
+	Sexpr* newthing = eval(unquote(first_arg), env);
 	sexpr_free(b);
 	return cons(newthing, rest);
 }
diff --git a/src/builtins/io.c b/src/builtins/io.c
index 1e54095..25ce07b 100644
--- a/src/builtins/io.c
+++ b/src/builtins/io.c
@@ -27,7 +27,7 @@ Sexpr* io_printstr(Sexpr* b, Sexpr* rest, Sexpr* env) {
 	if(IO_PRINTSTR_ARGS != u64_get_num_args(b)) {
 		return cons(b, rest);
 	}
-	Sexpr* arg = car(b->value.b.args);
+	Sexpr* arg = eval(clone(car(b->value.b.args)), env);
 	if(arg->type != STR) {
 		sexpr_free(b);
 		return cons(from_nil(), rest);
diff --git a/src/builtins/strings.c b/src/builtins/strings.c
new file mode 100644
index 0000000..8d2660b
--- /dev/null
+++ b/src/builtins/strings.c
@@ -0,0 +1,182 @@
+
+#include "../config.h"
+#include "../types.h"
+#include "../builtins.h"
+#include "../sexpr.h"
+#include "../eval.h"
+#include "../dict.h"
+#include "strings.h"
+
+#include <inttypes.h>
+#include <stdlib.h>
+#include <string.h>
+
+Sexpr* s_strlen(Sexpr* b, Sexpr* rest, Sexpr* env) {
+	if(STRINGS_STRLEN_ARGS != u64_get_num_args(b)) {
+		return cons(b, rest);
+	}
+	Sexpr* arg = car(b->value.b.args);
+#ifdef TYPECHECK
+	if(unquote(arg)->type != STR) {
+		ERR("strlen: ", "argument not string");
+		sexpr_free(b);
+		return cons(from_nil(), rest);
+	}
+#endif // typecheck
+	size_t sl = strlen(arg->value.str);
+	sexpr_free(b);
+	return cons (from_uint(sl), rest);
+}
+
+Sexpr* s_strcat(Sexpr* b, Sexpr* rest, Sexpr* env) {
+	if(STRINGS_STRCAT_ARGS != u64_get_num_args(b)) {
+		return cons(b, rest);
+	}
+	Sexpr* args = b->value.b.args;
+	Sexpr* snd = eval(clone(car(args)), env);
+	Sexpr* fst = eval(clone(car(cdr(args))), env);
+#ifdef TYPECHECK
+	if(snd->type != STR || fst->type != STR) {
+		ERR("strcat: ", "arguments not string");
+		sexpr_free(snd);
+		sexpr_free(fst);
+		sexpr_free(b);
+		return cons(from_nil(), rest);
+	}
+#endif // typecheck
+	char* fs = fst->value.str;
+	char* ss = snd->value.str;
+	char* out = malloc(sizeof(char)*(strlen(fs)+strlen(ss)));
+	strcpy(out, fs);
+	strcat(out, ss);
+	sexpr_free(snd);
+	sexpr_free(fst);
+	sexpr_free(b);
+	Sexpr* outval = cons(from_string(out), rest);
+	free(out);
+	return outval;
+}
+
+Sexpr* s_strat(Sexpr* b, Sexpr* rest, Sexpr* env) {
+	// wait, do i want this to be 1- or 0- indexed? currently 1...
+	if(STRINGS_STRAT_ARGS != u64_get_num_args(b)) {
+		return cons(b, rest);
+	}
+	Sexpr* args = b->value.b.args;
+	Sexpr* index = eval(clone(car(cdr(args))), env);
+	Sexpr* str = eval(clone(car(args)), env);
+#ifdef TYPECHECK
+	if(str->type != STR || index->type != UINT) {
+		ERR("strat: ", "arguments not string");
+		sexpr_free(index);
+		sexpr_free(str);
+		sexpr_free(b);
+		return cons(from_nil(), rest);
+	}
+#endif // typecheck
+	size_t len = strlen(str->value.str);
+	size_t idx = index->value.u;
+	if(len < idx) {
+		WARN("", "index out of bounds");
+		return cons(from_nil(), rest);
+	}
+	char at[] = { '\0', '\0'}; // for uh string stuff?
+	at[0] = str->value.str[idx-1];
+	sexpr_free(b);
+	sexpr_free(index);
+	sexpr_free(str);
+	return cons(from_string(at), rest);
+}
+
+Sexpr* s_strexpand(Sexpr* b, Sexpr* rest, Sexpr* env) {
+	if(STRINGS_STREXPAND_ARGS != u64_get_num_args(b)) {
+		return cons(b, rest);
+	}
+	Sexpr* args = b->value.b.args;
+	Sexpr* arg = eval(clone(car(args)), env);
+#ifdef TYPECHECK
+	if(arg->type != STR) {
+		ERR("strexpand: ", "argument not string");
+		sexpr_free(arg);
+		sexpr_free(b);
+		return cons(from_nil(), rest);
+	}
+#endif // typecheck
+	size_t len = strlen(arg->value.str);
+	Sexpr* toret = from_nil();
+	char arr[] = {'\0', '\0'};
+	while(len > 0) {
+		arr[0] = arg->value.str[len - 1];
+		toret = cons(from_string(arr), toret);
+		len--;
+	}
+	sexpr_free(arg);
+	sexpr_free(b);
+	return cons(from_quote(toret), rest);
+}
+
+Sexpr* s_substr(Sexpr* b, Sexpr* rest, Sexpr* env) {
+	if(STRINGS_SUBSTR_ARGS != u64_get_num_args(b)) {
+		return cons(b, rest);
+	}
+	Sexpr* args = b->value.b.args;
+	Sexpr* subex = eval(clone(car(cdr(args))), env);
+	Sexpr* strex = eval(clone(car(args)), env);
+#ifdef TYPECHECK
+	if(subex->type != STR || strex->type != STR) {
+		ERR("substr: ", "arguments not strings");
+		sexpr_free(subex);
+		sexpr_free(strex);
+		sexpr_free(b);
+		return cons(from_nil(), rest);
+	}
+#endif
+	Sexpr* result = from_nil();
+	char* sub = subex->value.str;
+	char* str = strex->value.str;
+	char* currstr = str;
+	char* res;
+	size_t idx;
+	while((res = strstr(currstr, sub)) != NULL) {
+		idx = res - str;
+		result = cons(from_uint(idx + 1), result);
+		// the plus one is to be consistent with strat
+		// not decided if that's how I want it to be though
+		currstr = res + 1;
+	}
+	sexpr_free(subex);
+	sexpr_free(strex);
+	sexpr_free(b);
+	Sexpr* newres = reverse(result);
+	sexpr_free(result);
+	return cons(from_quote(newres), rest);
+}
+
+Sexpr* x_strings_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
+	uint64_t code = b->value.b.opcode & 0xff;
+	switch(code) {
+	case STRINGS_STRLEN:
+		return s_strlen(b, rest, env);
+	case STRINGS_STRCAT:
+		return s_strcat(b, rest, env);
+	case STRINGS_STRAT:
+		return s_strat(b, rest, env);
+	case STRINGS_STREXPAND:
+		return s_strexpand(b, rest, env);
+	case STRINGS_SUBSTR:
+		return s_substr(b, rest, env);
+	default:
+		return from_nil();
+	}
+	return from_nil();
+}
+
+
+Sexpr* load_strings_env(Sexpr* env) {
+	load_builtin(STRINGS_STRLEN_STR, (STRINGS_PREFIX << 8) | STRINGS_STRLEN, env);
+	load_builtin(STRINGS_STRCAT_STR, (STRINGS_PREFIX << 8) | STRINGS_STRCAT, env);
+		load_builtin(STRINGS_STRAT_STR, (STRINGS_PREFIX << 8) | STRINGS_STRAT, env);
+		load_builtin(STRINGS_STREXPAND_STR, (STRINGS_PREFIX << 8) | STRINGS_STREXPAND, env);
+				load_builtin(STRINGS_SUBSTR_STR, (STRINGS_PREFIX << 8) | STRINGS_SUBSTR, env);
+	return env;
+}
diff --git a/src/builtins/strings.h b/src/builtins/strings.h
new file mode 100644
index 0000000..76c4e07
--- /dev/null
+++ b/src/builtins/strings.h
@@ -0,0 +1,29 @@
+#ifndef _B_STRINGS_H
+#define _B_STRINGS_H
+
+
+#include "../types.h"
+
+
+#define STRINGS_PREFIX 0x04
+
+#define STRINGS_STRLEN 0x00
+#define STRINGS_STRLEN_ARGS 1
+#define STRINGS_STRLEN_STR "strlen"
+#define STRINGS_STRCAT 0x01
+#define STRINGS_STRCAT_ARGS 2
+#define STRINGS_STRCAT_STR "strcat"
+#define STRINGS_STRAT 0x02
+#define STRINGS_STRAT_ARGS 2
+#define STRINGS_STRAT_STR "strat"
+#define STRINGS_STREXPAND 0x03
+#define STRINGS_STREXPAND_ARGS 1
+#define STRINGS_STREXPAND_STR "strexpand"
+#define STRINGS_SUBSTR 0x04
+#define STRINGS_SUBSTR_ARGS 2
+#define STRINGS_SUBSTR_STR "substr"
+
+Sexpr* x_strings_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
+Sexpr* load_strings_env(Sexpr* env);
+
+#endif