added some very dangerous meta-operations

also cleaned up some small error message things

diff --git a/src/builtins.c b/src/builtins.c
index 8f580ae1a648c758e146797b38731fd32b355feb..cc470a69ad1abda8622ebde0a72a6edd2447799c 100644 (file)
--- 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 "builtins/meta.h"
 #include "builtins/io.h"
 #include "builtins/strings.h"
 
@@ -28,6 +29,8 @@ Sexpr* dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
                return x_io_dispatch(b, rest, env);
        case STRINGS_PREFIX:
                return x_strings_dispatch(b, rest, env);
+       case META_PREFIX:
+               return x_meta_dispatch(b, rest, env);
        default:
                return from_nil();
        }
@@ -120,6 +123,7 @@ Sexpr* load_env(Sexpr* env) {
        newenv = load_comb_env(newenv);
        newenv = load_io_env(newenv);
        newenv = load_strings_env(newenv);
+       newenv = load_meta_env(newenv);
 
        return newenv;
 }

diff --git a/src/builtins/core.c b/src/builtins/core.c
index 1774fe31856f9993f002dcbbbcc4376c4b8f2e89..aeb497cf328cfc94ee5a5778da05babe21482975 100644 (file)
--- a/src/builtins/core.c
+++ b/src/builtins/core.c
@@ -46,7 +46,7 @@ Sexpr* c_car(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* unqargev = eval(clone(car(args)), env);
 #ifdef TYPECHECK
        if(unquote(unqargev)->type != CONS) {
-               ERR("car: ", "argument not cons cell");
+               ERR(CORE_CAR_STR ": ", "argument not cons cell");
                sexpr_free(b);
                sexpr_free(unqargev);
                return cons(from_nil(), rest);
@@ -64,7 +64,7 @@ Sexpr* c_cdr(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* unqargev = eval(clone(car(args)), env);
 #ifdef TYPECHECK
        if(unquote(unqargev)->type != CONS) {
-               ERR("cdr: ", "argument not cons cell");
+               ERR(CORE_CDR_STR ": ", "argument not cons cell");
                sexpr_free(b);
                sexpr_free(unqargev);
                return cons(from_nil(), rest);

diff --git a/src/builtins/io.c b/src/builtins/io.c
index c5141988ab8c62264e4fa58c0bef720278217cdd..18879663a639cabf4c98f63c5eaba167a4f530e0 100644 (file)
--- a/src/builtins/io.c
+++ b/src/builtins/io.c
@@ -61,7 +61,7 @@ Sexpr* io_readfile(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* firstarg = eval(clone(car(b->value.b.args)), env);
 #ifdef TYPECHECK
        if(firstarg->type != STR) {
-               ERR("readfile: ", "argument not a string");
+               ERR(IO_READFILE_STR ": ", "argument not a string");
                sexpr_free(firstarg);
                sexpr_free(b);
                return cons(from_nil(), rest);
@@ -69,7 +69,7 @@ Sexpr* io_readfile(Sexpr* b, Sexpr* rest, Sexpr* env) {
 #endif
        FILE* thefile = fopen(firstarg->value.str, "r");
        if(!thefile) {
-               ERR("readfile: file not found: ", firstarg->value.str);
+               ERR(IO_READFILE_STR ": file not found: ", firstarg->value.str);
                sexpr_free(firstarg);
                sexpr_free(b);
                return cons(from_nil(), rest);
@@ -81,7 +81,7 @@ Sexpr* io_readfile(Sexpr* b, Sexpr* rest, Sexpr* env) {
        fseek(thefile, 0, SEEK_SET);
        char* buf = malloc(sizeof(char)*fsz);
        if(!buf) {
-               ERR("readfile: ", "unable to allocate memory for file");
+               ERR(IO_READFILE_STR ": ", "unable to allocate memory for file");
                fclose(thefile);
                return cons(from_nil(), rest);
        }
@@ -101,7 +101,7 @@ Sexpr* io_writefile(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* strarg = eval(clone(car(args)), env);
 #ifdef TYPECHECK
        if(filearg->type != STR || strarg->type != STR) {
-               ERR("writefile: ", "arguments not strings");
+               ERR(IO_WRITEFILE_STR ": ", "arguments not strings");
                sexpr_free(filearg);
                sexpr_free(strarg);
                sexpr_free(b);
@@ -111,7 +111,7 @@ Sexpr* io_writefile(Sexpr* b, Sexpr* rest, Sexpr* env) {
        char* filestring = filearg->value.str;
        FILE* thefile = fopen(filestring, "w");
        if(!thefile) {
-               ERR("writefile: file not found: ", filestring);
+               ERR(IO_WRITEFILE_STR ": file not found: ", filestring);
                sexpr_free(filearg);
                sexpr_free(strarg);
                sexpr_free(b);

diff --git a/src/builtins/io.h b/src/builtins/io.h
index f62db668473e79842292062050f00054af66909c..2d0b42bf9f79c8fd4d32d7fae39bb4bcee7946d2 100644 (file)
--- a/src/builtins/io.h
+++ b/src/builtins/io.h
@@ -3,7 +3,7 @@
 
 #include "../types.h"
 
-#define IO_PREFIX 0x03
+#define IO_PREFIX 0x04
 
 #define IO_PRINT 0x00
 #define IO_PRINT_ARGS 1

diff --git a/src/builtins/meta.c b/src/builtins/meta.c
new file mode 100644 (file)
index 0000000..54c3016
--- /dev/null
+++ b/src/builtins/meta.c
@@ -0,0 +1,161 @@
+
+#include "../config.h"
+#include "../types.h"
+#include "../builtins.h"
+#include "../sexpr.h"
+#include "../eval.h"
+#include "../dict.h"
+#include "../parser.h"
+#include "meta.h"
+
+Sexpr* m_utob(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       if(META_UTOB_ARGS != u64_get_num_args(b)) {
+               return cons(b, rest);
+       }
+       Sexpr* arg = eval(clone(car(b->value.b.args)), env);
+#ifdef TYPECHECK
+       if(unquote(arg)->type != UINT) {
+               ERR(META_UTOB_STR ": ", "argument not uint");
+               sexpr_free(b);
+               sexpr_free(arg);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
+       Sexpr* out = from_opcode(unquote(arg)->value.u);
+       sexpr_free(b);
+       sexpr_free(arg);
+       return cons(out, rest);
+}
+
+Sexpr* m_btou(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       if(META_BTOU_ARGS != u64_get_num_args(b)) {
+               return cons(b, rest);
+       }
+       Sexpr* arg = eval(clone(car(b->value.b.args)), env);
+#ifdef TYPECHECK
+       if(unquote(arg)->type != BUILTIN) {
+               ERR(META_BTOU_STR ": ", "argument not builtin");
+               sexpr_free(b);
+               sexpr_free(arg);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
+       Sexpr* out = from_uint(unquote(arg)->value.b.opcode);
+       sexpr_free(b);
+       sexpr_free(arg);
+       return cons(out, rest);
+}
+
+Sexpr* m_parse(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       if(META_PARSE_ARGS != u64_get_num_args(b)) {
+               return cons(b, rest);
+       }
+       Sexpr* arg = eval(clone(car(b->value.b.args)), env);
+#ifdef TYPECHECK
+       if(unquote(arg)->type != STR) {
+               ERR(META_PARSE_STR ": ", "argument not string");
+               sexpr_free(b);
+               sexpr_free(arg);
+               return cons(from_nil(), rest);
+       }
+#endif
+       Sexpr* out = parse(unquote(arg)->value.str);
+       sexpr_free(b);
+       sexpr_free(arg);
+       if(out == NULL) {
+               ERR(META_PARSE_STR ": ", "bad input");
+               return cons(from_nil(), rest);
+       }
+       return cons(from_quote(out), rest);
+}
+
+Sexpr* m_getargs(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       if(META_GETARGS_ARGS != u64_get_num_args(b)) {
+               return cons(b, rest);
+       }
+       Sexpr* arg = eval(clone(car(b->value.b.args)), env);
+#ifdef TYPECHECK
+       if(unquote(arg)->type != BUILTIN) {
+               ERR(META_GETARGS_STR ": ", "argument not builtin");
+               sexpr_free(b);
+               sexpr_free(arg);
+               return cons(from_nil(), rest);
+       }
+#endif
+       Sexpr* args = clone(unquote(arg)->value.b.args); // poorly named variable?
+       sexpr_free(arg);
+       sexpr_free(b);
+       return cons(from_quote(args), rest);
+}
+
+Sexpr* m_getenv(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       // lol what kind of argument would even be appropriate here?
+       // maybe i should just only accept t, to limit misuse (lol)
+       if(META_GETENV_ARGS != u64_get_num_args(b)) {
+               return cons(b, rest);
+       }
+       Sexpr* arg = eval(clone(car(b->value.b.args)), env);
+       if(arg->type != T) {
+               ERR(META_GETENV_STR ": ", "incorrect call");
+               sexpr_free(b);
+               sexpr_free(arg);
+               return cons(from_nil(), rest);
+       }
+       return cons(from_quote(clone(env)), rest);
+}
+
+Sexpr* m_setenv(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       // the most dangerous game
+       if(META_SETENV_ARGS != u64_get_num_args(b)) {
+               return cons(b, rest);
+       }
+       Sexpr* arg = eval(clone(car(b->value.b.args)), env);
+       if(arg->type != CONS && cdr(arg)->type != NIL) {
+               ERR(META_SETENV_STR ": ", "not well-formed");
+               sexpr_free(b);
+               sexpr_free(arg);
+               return cons(from_nil(), rest);
+       }
+       // todo
+       sexpr_free(b);
+       sexpr_free(arg);
+       return cons(from_t(), rest);
+}
+
+
+
+
+Sexpr* x_meta_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
+       uint64_t code = b->value.b.opcode & 0xff;
+
+       switch(code) {
+       case META_UTOB:
+               return m_utob(b, rest, env);
+       case META_BTOU:
+               return m_btou(b, rest, env);
+       case META_PARSE:
+               return m_parse(b, rest, env);
+       case META_GETARGS:
+               return m_getargs(b, rest, env);
+       case META_GETENV:
+               return m_getenv(b, rest, env);
+       case META_SETENV:
+               return m_setenv(b, rest, env);
+       default:
+               return from_nil();
+       }
+       return from_nil();
+
+}
+
+Sexpr* load_meta_env(Sexpr* env) {
+       load_builtin(META_UTOB_STR, (META_PREFIX << 8) | META_UTOB, env);
+       load_builtin(META_BTOU_STR, (META_PREFIX << 8) | META_BTOU, env);
+       load_builtin(META_PARSE_STR, (META_PREFIX << 8) | META_PARSE, env);
+       load_builtin(META_GETARGS_STR, (META_PREFIX << 8) | META_GETARGS, env);
+       load_builtin(META_GETENV_STR, (META_PREFIX << 8) | META_GETENV, env);
+       load_builtin(META_SETENV_STR, (META_PREFIX << 8) | META_SETENV, env);
+
+
+       return env;
+}

diff --git a/src/builtins/meta.h b/src/builtins/meta.h
new file mode 100644 (file)
index 0000000..070c318
--- /dev/null
+++ b/src/builtins/meta.h
@@ -0,0 +1,32 @@
+#ifndef _B_META_H
+#define _B_META_H
+
+
+#include "../types.h"
+
+
+#define META_PREFIX 0x03
+
+#define META_UTOB 0x00
+#define META_UTOB_ARGS 1
+#define META_UTOB_STR "utob"
+#define META_BTOU 0x01
+#define META_BTOU_ARGS 1
+#define META_BTOU_STR "btou"
+#define META_PARSE 0x02
+#define META_PARSE_ARGS 1
+#define META_PARSE_STR "parse"
+#define META_GETARGS 0x03
+#define META_GETARGS_ARGS 1
+#define META_GETARGS_STR "getargs"
+#define META_GETENV 0x04
+#define META_GETENV_ARGS 1
+#define META_GETENV_STR "getenv"
+#define META_SETENV 0x05
+#define META_SETENV_ARGS 1
+#define META_SETENV_STR "setenv"
+
+Sexpr* x_meta_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
+Sexpr* load_meta_env(Sexpr* env);
+
+#endif

diff --git a/src/builtins/strings.c b/src/builtins/strings.c
index 71182959fa0701a2be6742a593525c4df1826550..b067d6baff345effbf549692e2f9302c73764492 100644 (file)
--- a/src/builtins/strings.c
+++ b/src/builtins/strings.c
@@ -18,7 +18,7 @@ Sexpr* s_strlen(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* arg = eval(clone(car(b->value.b.args)), env);
 #ifdef TYPECHECK
        if(unquote(arg)->type != STR) {
-               ERR("strlen: ", "argument not string");
+               ERR(STRINGS_STRLEN_STR ": ", "argument not string");
                sexpr_free(b);
                sexpr_free(arg);
                return cons(from_nil(), rest);
@@ -39,7 +39,7 @@ Sexpr* s_strcat(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* fst = eval(clone(car(cdr(args))), env);
 #ifdef TYPECHECK
        if(unquote(snd)->type != STR || unquote(fst)->type != STR) {
-               ERR("strcat: ", "arguments not string");
+               ERR(STRINGS_STRCAT_STR ": ", "arguments not string");
                sexpr_free(snd);
                sexpr_free(fst);
                sexpr_free(b);
@@ -69,7 +69,7 @@ Sexpr* s_strat(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* str = eval(clone(car(args)), env);
 #ifdef TYPECHECK
        if(unquote(str)->type != STR || unquote(index)->type != UINT) {
-               ERR("strat: ", "arguments not string");
+               ERR(STRINGS_STRAT_STR ": ", "arguments not string");
                sexpr_free(index);
                sexpr_free(str);
                sexpr_free(b);
@@ -98,7 +98,7 @@ Sexpr* s_strexpand(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* arg = eval(clone(car(args)), env);
 #ifdef TYPECHECK
        if(unquote(arg)->type != STR) {
-               ERR("strexpand: ", "argument not string");
+               ERR(STRINGS_STREXPAND_STR ": ", "argument not string");
                sexpr_free(arg);
                sexpr_free(b);
                return cons(from_nil(), rest);
@@ -126,7 +126,7 @@ Sexpr* s_substr(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* strex = eval(clone(car(args)), env);
 #ifdef TYPECHECK
        if(unquote(subex)->type != STR || unquote(strex)->type != STR) {
-               ERR("substr: ", "arguments not strings");
+               ERR(STRINGS_SUBSTR_STR ": ", "arguments not strings");
                sexpr_free(subex);
                sexpr_free(strex);
                sexpr_free(b);
@@ -163,7 +163,7 @@ Sexpr* s_strtok(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* strex = eval(clone(car(args)), env);
 #ifdef TYPECHECK
        if(unquote(delimex)->type != STR || unquote(strex)->type != STR) {
-               ERR("strtok: ", "arguments not strings");
+               ERR(STRINGS_STRTOK_STR ": ", "arguments not strings");
                sexpr_free(delimex);
                sexpr_free(strex);
                sexpr_free(b);

diff --git a/src/builtins/strings.h b/src/builtins/strings.h
index 289eea58ba04ee95b4a390c1507f27859ed87727..243a0d8c92d9af713276319a9b54f30a2d60abdf 100644 (file)
--- a/src/builtins/strings.h
+++ b/src/builtins/strings.h
@@ -5,7 +5,7 @@
 #include "../types.h"
 
 
-#define STRINGS_PREFIX 0x04
+#define STRINGS_PREFIX 0x05
 
 #define STRINGS_STRLEN 0x00
 #define STRINGS_STRLEN_ARGS 1