From beab39609743e3ab944f39539164e4322f075769 Mon Sep 17 00:00:00 2001 From: Elijah Cohen Date: Tue, 26 Nov 2024 16:35:52 -0600 Subject: [PATCH] added some very dangerous meta-operations also cleaned up some small error message things --- src/builtins.c | 4 + src/builtins/core.c | 4 +- src/builtins/io.c | 10 +-- src/builtins/io.h | 2 +- src/builtins/meta.c | 161 +++++++++++++++++++++++++++++++++++++++++ src/builtins/meta.h | 32 ++++++++ src/builtins/strings.c | 12 +-- src/builtins/strings.h | 2 +- 8 files changed, 212 insertions(+), 15 deletions(-) create mode 100644 src/builtins/meta.c create mode 100644 src/builtins/meta.h diff --git a/src/builtins.c b/src/builtins.c index 8f580ae..cc470a6 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 "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 1774fe3..aeb497c 100644 --- 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 c514198..1887966 100644 --- 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 f62db66..2d0b42b 100644 --- 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 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 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 7118295..b067d6b 100644 --- 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 289eea5..243a0d8 100644 --- 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 -- 2.39.5