some very basic string things

diff --git a/demos.kl b/demos.kl
index a1da106beec4f3aa0539087f30d7831cb9677679..65146509e78384e0f2f647c2550945e24f0409b3 100644 (file)
--- 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 5239e8e75328b395646d8916a72ebe3f5f0ce967..c38a0c96a59f6c22ae6d755c4b6de24ff25b0a16 100644 (file)
--- 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 fdc1736093f2ff682d322cb7babedd0bceb8a014..71ae600d361cc2cd0e9c3440933430f3be674bc7 100644 (file)
--- 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 1e540957e364bc46d67483bd8e07ae202bbef7fb..25ce07bf691229b0ed3372b42b679d48fee5529b 100644 (file)
--- 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 (file)
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 (file)
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