From 1232e077f5273d86600cb4a4c34269310f9f2b9f Mon Sep 17 00:00:00 2001 From: Mistivia Date: Sun, 14 Dec 2025 17:41:43 +0800 Subject: add io ext --- .vscode/settings.json | 3 + exts/Makefile | 31 +++++ exts/dict.c | 182 ++++++++++++++++++++++++++++ exts/dict/Makefile | 0 exts/dict/main.c | 165 -------------------------- exts/dict/test.lisp | 0 exts/io.c | 295 ++++++++++++++++++++++++++++++++++++++++++++++ exts/io/main.c | 0 exts/test_input.txt | 3 + exts/tests/test_dict.lisp | 17 +++ exts/tests/test_io.lisp | 15 +++ exts/vector.c | 129 ++++++++++++++++++++ exts/vector/Makefile | 0 exts/vector/main.c | 129 -------------------- exts/vector/test.lisp | 0 15 files changed, 675 insertions(+), 294 deletions(-) create mode 100644 .vscode/settings.json create mode 100644 exts/dict.c delete mode 100644 exts/dict/Makefile delete mode 100644 exts/dict/main.c delete mode 100644 exts/dict/test.lisp create mode 100644 exts/io.c delete mode 100644 exts/io/main.c create mode 100644 exts/test_input.txt create mode 100644 exts/tests/test_dict.lisp create mode 100644 exts/tests/test_io.lisp create mode 100644 exts/vector.c delete mode 100644 exts/vector/Makefile delete mode 100644 exts/vector/main.c delete mode 100644 exts/vector/test.lisp diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..082b194 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,3 @@ +{ + "makefile.configureOnOpen": false +} \ No newline at end of file diff --git a/exts/Makefile b/exts/Makefile index e69de29..c80de69 100644 --- a/exts/Makefile +++ b/exts/Makefile @@ -0,0 +1,31 @@ +mode ?= debug +cc = gcc + +cflags = -DWITHREADLINE -fPIC + +ldflags = -lm -lalgds -lbamboo-lisp +ifeq ($(mode), debug) + cflags += -g +else + cflags += -O2 +endif + +objs = \ + vector.so \ + dict.so \ + io.so + +all: $(objs) + +vector.so: vector.c + gcc -shared $(cflags) -o $@ $^ $(ldflags) + +dict.so: dict.c + gcc -shared $(cflags) -o $@ $^ $(ldflags) + +io.so: io.c + gcc -shared $(cflags) -o $@ $^ $(ldflags) + +install: + mkdir -p /usr/local/share/bamboo-lisp/exts/ + cp $(objs) /usr/local/share/bamboo-lisp/exts/ \ No newline at end of file diff --git a/exts/dict.c b/exts/dict.c new file mode 100644 index 0000000..772e48f --- /dev/null +++ b/exts/dict.c @@ -0,0 +1,182 @@ +#include +#include + +#include +#include +#include +#include + +TREE_MAP_DEF(String, SExpRef); +TREE_MAP_IMPL(String, SExpRef); + +typedef String2SExpRefTreeMap DictMap; +typedef String2SExpRefTreeMapIter DictIter; +typedef String2SExpRefTreeMapNode DictNode; + +LispUserdataMeta bamboo_lisp_dict_meta; + +#define DICT_TYPEID "ext.core.dict" + +static bool is_dict_impl(Interp *interp, SExpRef obj) { + if (VALTYPE(obj) == kUserDataSExp && strcmp(DICT_TYPEID, REF(obj)->userdata_meta->type) == 0) { + return true; + } + return false; +} + +static void dict_free(void *vself) { + DictMap *map = (DictMap *)vself; + + DictIter it = String2SExpRefTreeMap_min(map); + while (it != NULL) { + if (it->key) { + free((void*)it->key); + it->key = NULL; + } + it = String2SExpRefTreeMap_next(map, it); + } + + String2SExpRefTreeMap_free(map); + + free(map); +} + + +static void dict_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) { + DictMap *map = (DictMap *)vself; + + DictIter it = String2SExpRefTreeMap_min(map); + while (it != NULL) { + SExpRef val = it->value; + SExpPtr ptr = REF(val); + + if (ptr && !ptr->marked) { + SExpPtrVector_push_back(gcstack, ptr); + } + + it = String2SExpRefTreeMap_next(map, it); + } +} + + +static SExpRef ext_is_dict(Interp* interp, SExpRef args) { + if (LENGTH(args) != 1) return new_error(interp, "dict?: wrongs args num.\n"); + return new_boolean(interp, is_dict_impl(interp, CAR(args))); +} + +// (make-dict) +static SExpRef ext_make_dict(Interp* interp, SExpRef args) { + if (LENGTH(args) != 0) return new_error(interp, "make-dict: expects no args.\n"); + + SExpRef ret = new_sexp(interp); + REF(ret)->type = kUserDataSExp; + REF(ret)->userdata_meta = &bamboo_lisp_dict_meta; + + DictMap *map = malloc(sizeof(DictMap)); + if (!map) return new_error(interp, "make-dict: out of memory.\n"); + + String2SExpRefTreeMap_init(map); + REF(ret)->userdata = map; + + return ret; +} + +// (dict-set dict key value) +static SExpRef ext_dict_set(Interp* interp, SExpRef args) { + if (LENGTH(args) != 3) return new_error(interp, "dict-set: wrong args num.\n"); + + SExpRef r_dict = CAR(args); + SExpRef r_key = CADR(args); + SExpRef r_val = CADDR(args); + + if (!is_dict_impl(interp, r_dict)) return new_error(interp, "dict-set: first arg not a dict.\n"); + if (REF(r_key)->type != kStringSExp) return new_error(interp, "dict-set: key must be a string.\n"); + + DictMap *map = REF(r_dict)->userdata; + const char *key_str = REF(r_key)->str; + + DictIter it = String2SExpRefTreeMap_find(map, key_str); + if (it != NULL) { + it->value = r_val; + } else { + char *key_dup = strdup(key_str); + String2SExpRefTreeMap_insert(map, key_dup, r_val); + } + + return NIL; +} + +// (dict-get dict key) -> value or nil +static SExpRef ext_dict_get(Interp* interp, SExpRef args) { + if (LENGTH(args) != 2) return new_error(interp, "dict-get: wrong args num.\n"); + + SExpRef r_dict = CAR(args); + SExpRef r_key = CADR(args); + + if (!is_dict_impl(interp, r_dict)) return new_error(interp, "dict-get: first arg not a dict.\n"); + if (REF(r_key)->type != kStringSExp) return new_error(interp, "dict-get: key must be a string.\n"); + + DictMap *map = REF(r_dict)->userdata; + const char *key_str = REF(r_key)->str; + + SExpRef *val_ptr = String2SExpRefTreeMap_get(map, key_str); + if (val_ptr == NULL) { + return NIL; + } + return *val_ptr; +} + +// (dict-remove dict key) +static SExpRef ext_dict_remove(Interp* interp, SExpRef args) { + if (LENGTH(args) != 2) return new_error(interp, "dict-remove: wrong args num.\n"); + + SExpRef r_dict = CAR(args); + SExpRef r_key = CADR(args); + + if (!is_dict_impl(interp, r_dict)) return new_error(interp, "dict-remove: first arg not a dict.\n"); + if (REF(r_key)->type != kStringSExp) return new_error(interp, "dict-remove: key must be a string.\n"); + + DictMap *map = REF(r_dict)->userdata; + const char *key_str = REF(r_key)->str; + + DictIter it = String2SExpRefTreeMap_find(map, key_str); + if (it != NULL) { + const char *owned_key = it->key; + String2SExpRefTreeMap_remove(map, it); + if (owned_key) free((void*)owned_key); + free(it); + } + + return NIL; +} + +static SExpRef ext_dict_keys(Interp *interp, SExpRef args) { + if (LENGTH(args) != 1) return new_error(interp, "dict-keys: wrong args num.\n"); + SExpRef dict = CAR(args); + if (!is_dict_impl(interp, dict)) return new_error(interp, "dict-keys: first arg not a dict.\n"); + DictMap *map = REF(dict)->userdata; + DictIter it = String2SExpRefTreeMap_min(map); + SExpRef lst = NIL; + while (it != NULL) { + const char* key_str = it->key; + SExpRef keyobj = new_string(interp, key_str); + lst = CONS(keyobj, lst); + it = String2SExpRefTreeMap_next(map, it); + } + lst = lisp_nreverse(interp, lst); + return lst; +} + +int bamboo_lisp_ext_init(Interp *interp) { + bamboo_lisp_dict_meta.type = DICT_TYPEID; + bamboo_lisp_dict_meta.free = &dict_free; + bamboo_lisp_dict_meta.gcmark = &dict_gcmark; + + Interp_add_userfunc(interp, "dict?", &ext_is_dict); + Interp_add_userfunc(interp, "make-dict", &ext_make_dict); + Interp_add_userfunc(interp, "dict-get", &ext_dict_get); + Interp_add_userfunc(interp, "dict-set", &ext_dict_set); + Interp_add_userfunc(interp, "dict-remove", &ext_dict_remove); + Interp_add_userfunc(interp, "dict-keys", &ext_dict_keys); + return 1; +} \ No newline at end of file diff --git a/exts/dict/Makefile b/exts/dict/Makefile deleted file mode 100644 index e69de29..0000000 diff --git a/exts/dict/main.c b/exts/dict/main.c deleted file mode 100644 index 30eceb6..0000000 --- a/exts/dict/main.c +++ /dev/null @@ -1,165 +0,0 @@ -#include -#include - -#include -#include -#include -#include - -TREE_MAP_DEF(String, SExpRef); -TREE_MAP_IMPL(String, SExpRef); - -typedef String2SExpRefTreeMap DictMap; -typedef String2SExpRefTreeMapIter DictIter; -typedef String2SExpRefTreeMapNode DictNode; - -LispUserdataMeta bamboo_lisp_dict_meta; - -#define DICT_TYPEID "ext.core.dict" - -static bool is_dict_impl(Interp *interp, SExpRef obj) { - if (VALTYPE(obj) == kUserDataSExp && strcmp(DICT_TYPEID, REF(obj)->userdata_meta->type) == 0) { - return true; - } - return false; -} - -static void dict_free(void *vself) { - DictMap *map = (DictMap *)vself; - - DictIter it = String2SExpRefTreeMap_min(map); - while (it != NULL) { - if (it->key) { - free((void*)it->key); - it->key = NULL; - } - it = String2SExpRefTreeMap_next(map, it); - } - - String2SExpRefTreeMap_free(map); - - free(map); -} - - -static void dict_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) { - DictMap *map = (DictMap *)vself; - - DictIter it = String2SExpRefTreeMap_min(map); - while (it != NULL) { - SExpRef val = it->value; - SExpPtr ptr = REF(val); - - if (ptr && !ptr->marked) { - SExpPtrVector_push_back(gcstack, ptr); - } - - it = String2SExpRefTreeMap_next(map, it); - } -} - - -static SExpRef lisp_is_dict(Interp* interp, SExpRef args) { - if (LENGTH(args) != 1) return new_error(interp, "dict?: wrongs args num.\n"); - return new_boolean(interp, is_dict_impl(interp, CAR(args))); -} - -// (make-dict) -static SExpRef lisp_make_dict(Interp* interp, SExpRef args) { - if (LENGTH(args) != 0) return new_error(interp, "make-dict: expects no args.\n"); - - SExpRef ret = new_sexp(interp); - REF(ret)->type = kUserDataSExp; - REF(ret)->userdata_meta = &bamboo_lisp_dict_meta; - - DictMap *map = malloc(sizeof(DictMap)); - if (!map) return new_error(interp, "make-dict: out of memory.\n"); - - String2SExpRefTreeMap_init(map); - REF(ret)->userdata = map; - - return ret; -} - -// (dict-set dict key value) -static SExpRef lisp_dict_set(Interp* interp, SExpRef args) { - if (LENGTH(args) != 3) return new_error(interp, "dict-set: wrong args num.\n"); - - SExpRef r_dict = CAR(args); - SExpRef r_key = CADR(args); - SExpRef r_val = CADDR(args); - - if (!is_dict_impl(interp, r_dict)) return new_error(interp, "dict-set: first arg not a dict.\n"); - if (REF(r_key)->type != kStringSExp) return new_error(interp, "dict-set: key must be a string.\n"); - - DictMap *map = REF(r_dict)->userdata; - const char *key_str = REF(r_key)->str; - - DictIter it = String2SExpRefTreeMap_find(map, key_str); - if (it != NULL) { - it->value = r_val; - } else { - char *key_dup = strdup(key_str); - String2SExpRefTreeMap_insert(map, key_dup, r_val); - } - - return NIL; -} - -// (dict-get dict key) -> value or nil -static SExpRef lisp_dict_get(Interp* interp, SExpRef args) { - if (LENGTH(args) != 2) return new_error(interp, "dict-get: wrong args num.\n"); - - SExpRef r_dict = CAR(args); - SExpRef r_key = CADR(args); - - if (!is_dict_impl(interp, r_dict)) return new_error(interp, "dict-get: first arg not a dict.\n"); - if (REF(r_key)->type != kStringSExp) return new_error(interp, "dict-get: key must be a string.\n"); - - DictMap *map = REF(r_dict)->userdata; - const char *key_str = REF(r_key)->str; - - SExpRef *val_ptr = String2SExpRefTreeMap_get(map, key_str); - if (val_ptr == NULL) { - return NIL; - } - return *val_ptr; -} - -// (dict-remove dict key) -static SExpRef lisp_dict_remove(Interp* interp, SExpRef args) { - if (LENGTH(args) != 2) return new_error(interp, "dict-remove: wrong args num.\n"); - - SExpRef r_dict = CAR(args); - SExpRef r_key = CADR(args); - - if (!is_dict_impl(interp, r_dict)) return new_error(interp, "dict-remove: first arg not a dict.\n"); - if (REF(r_key)->type != kStringSExp) return new_error(interp, "dict-remove: key must be a string.\n"); - - DictMap *map = REF(r_dict)->userdata; - const char *key_str = REF(r_key)->str; - - DictIter it = String2SExpRefTreeMap_find(map, key_str); - if (it != NULL) { - const char *owned_key = it->key; - String2SExpRefTreeMap_remove(map, it); - if (owned_key) free((void*)owned_key); - free(it); - } - - return NIL; -} - -int bamboo_lisp_dict_ext_init(Interp *interp) { - bamboo_lisp_dict_meta.type = DICT_TYPEID; - bamboo_lisp_dict_meta.free = &dict_free; - bamboo_lisp_dict_meta.gcmark = &dict_gcmark; - - Interp_add_userfunc(interp, "dict?", &lisp_is_dict); - Interp_add_userfunc(interp, "make-dict", &lisp_make_dict); - Interp_add_userfunc(interp, "dict-get", &lisp_dict_get); - Interp_add_userfunc(interp, "dict-set", &lisp_dict_set); - Interp_add_userfunc(interp, "dict-remove", &lisp_dict_remove); - // TODO dict-keys - return 1; -} \ No newline at end of file diff --git a/exts/dict/test.lisp b/exts/dict/test.lisp deleted file mode 100644 index e69de29..0000000 diff --git a/exts/io.c b/exts/io.c new file mode 100644 index 0000000..76c1520 --- /dev/null +++ b/exts/io.c @@ -0,0 +1,295 @@ +#include +#include +#include +#include + +#include +#include + +#define STREAM_TYPEID "ext.core.stream" + +typedef struct { + FILE *fp; + bool should_close; +} LispStream; + +LispUserdataMeta bamboo_lisp_stream_meta; + +static bool is_stream_impl(Interp *interp, SExpRef obj) { + if (VALTYPE(obj) == kUserDataSExp && + strcmp(STREAM_TYPEID, REF(obj)->userdata_meta->type) == 0) { + return true; + } + return false; +} + +static SExpRef make_stream(Interp* interp, FILE *fp, bool should_close) { + SExpRef ret = new_sexp(interp); + REF(ret)->type = kUserDataSExp; + REF(ret)->userdata_meta = &bamboo_lisp_stream_meta; + + LispStream *s = malloc(sizeof(LispStream)); + s->fp = fp; + s->should_close = should_close; + + REF(ret)->userdata = s; + return ret; +} + +static FILE* get_input_stream(Interp* interp, SExpRef args, const char* func_name) { + if (NILP(args)) return stdin; + + SExpRef first = CAR(args); + if (!is_stream_impl(interp, first)) { + new_error(interp, "%s: argument is not a stream.\n", func_name); + return NULL; + } + LispStream *s = (LispStream*)REF(first)->userdata; + return s->fp; +} + +static FILE* get_output_stream(Interp* interp, SExpRef args, const char* func_name) { + if (NILP(args)) return stdout; + + SExpRef first = CAR(args); + if (!is_stream_impl(interp, first)) { + new_error(interp, "%s: argument is not a stream.\n", func_name); + return NULL; + } + LispStream *s = (LispStream*)REF(first)->userdata; + return s->fp; +} + +// (stream? obj) +static SExpRef ext_is_stream(Interp* interp, SExpRef args) { + if (LENGTH(args) != 1) return new_error(interp, "stream?: wrong args num.\n"); + return new_boolean(interp, is_stream_impl(interp, CAR(args))); +} + +// (open-file filename mode) -> stream +static SExpRef ext_open_file(Interp* interp, SExpRef args) { + if (LENGTH(args) != 2) return new_error(interp, "open-file: wrong args num.\n"); + + SExpRef arg_fname = CAR(args); + SExpRef arg_mode = CADR(args); + + if (VALTYPE(arg_fname) != kStringSExp || VALTYPE(arg_mode) != kStringSExp) { + return new_error(interp, "open-file: filename and mode must be strings.\n"); + } + + const char *fname = REF(arg_fname)->str; + const char *mode = REF(arg_mode)->str; + + FILE *fp = fopen(fname, mode); + if (!fp) { + return new_error(interp, "open-file: failed to open file '%s'.\n", fname); + } + + return make_stream(interp, fp, true); +} + +// (read-char [stream]) +static SExpRef ext_read_char(Interp* interp, SExpRef args) { + if (LENGTH(args) > 1) return new_error(interp, "read-char: too many args.\n"); + + FILE *fp = get_input_stream(interp, args, "read-char"); + if (!fp) return NIL; // Error handled in get_input_stream but returns NULL + + int c = fgetc(fp); + if (c == EOF) return NIL; // End of file returns NIL + + return new_char(interp, (char)c); +} + +// (read-integer [stream]) +static SExpRef ext_read_integer(Interp* interp, SExpRef args) { + if (LENGTH(args) > 1) return new_error(interp, "read-integer: too many args.\n"); + + FILE *fp = get_input_stream(interp, args, "read-integer"); + if (!fp) return NIL; + + long long val; + + int c; + while(isspace(c = fgetc(fp))); + ungetc(c, fp); + + if (fscanf(fp, "%lld", &val) == 1) { + return new_integer(interp, val); + } + return NIL; +} + +static SExpRef ext_read_number(Interp* interp, SExpRef args) { + if (LENGTH(args) > 1) return new_error(interp, "read-number: too many args.\n"); + + FILE *fp = get_input_stream(interp, args, "read-number"); + if (!fp) return NIL; + + char buffer[64]; + int idx = 0; + int c; + + while ((c = fgetc(fp)) != EOF && isspace(c)); + + if (c == EOF) return NIL; + + do { + if (idx < 63) buffer[idx++] = (char)c; + c = fgetc(fp); + } while (c != EOF && !isspace(c) && c != ')' && c != '('); + + if (c != EOF) ungetc(c, fp); + buffer[idx] = '\0'; + + if (strchr(buffer, '.') != NULL) { + char *end; + double d = strtod(buffer, &end); + if (end != buffer) return new_real(interp, d); + } else { + char *end; + long long i = strtoll(buffer, &end, 10); + if (end != buffer) return new_integer(interp, i); + } + + return NIL; +} + +static char* internal_read_line(FILE *fp) { + size_t cap = 128; + size_t len = 0; + char *buf = malloc(cap); + if (!buf) return NULL; + + int c = fgetc(fp); + if (c == EOF) { + free(buf); + return NULL; + } + + while (c != EOF && c != '\n') { + if (len + 1 >= cap) { + cap *= 2; + char *new_buf = realloc(buf, cap); + if (!new_buf) { free(buf); return NULL; } + buf = new_buf; + } + buf[len++] = (char)c; + c = fgetc(fp); + } + buf[len] = '\0'; + return buf; +} + +// (read-line [stream]) +static SExpRef ext_read_line(Interp* interp, SExpRef args) { + if (LENGTH(args) > 1) return new_error(interp, "read-line: too many args.\n"); + + FILE *fp = get_input_stream(interp, args, "read-line"); + if (!fp) return NIL; + + char *line = internal_read_line(fp); + if (line) { + SExpRef ret = new_string(interp, line); + free(line); + return ret; + } + return NIL; +} + +// (lines stream) -> list of strings +static SExpRef ext_lines(Interp* interp, SExpRef args) { + if (LENGTH(args) != 1) return new_error(interp, "lines: wrong args num.\n"); + + FILE *fp = get_input_stream(interp, args, "lines"); + if (!fp) return NIL; + + SExpRef list_head = NIL; + + char *line_str; + while ((line_str = internal_read_line(fp)) != NULL) { + SExpRef s = new_string(interp, line_str); + free(line_str); + list_head = CONS(s, list_head); + } + + return lisp_nreverse(interp, list_head); +} + +static SExpRef ext_stream_close(Interp *interp, SExpRef args) { + if (LENGTH(args) != 1) return new_error(interp, "stream-close: wrong args num.\n"); + SExpRef first = CAR(args); + if (!is_stream_impl(interp, first)) { + return new_error(interp, "stream-close: argument is not a stream.\n"); + } + LispStream *s = (LispStream*)REF(first)->userdata; + if (s->should_close && s->fp != NULL) { + fclose(s->fp); + s->fp = NULL; + s->should_close = false; + } + return NIL; +} + +// (write-char c [stream]) +static SExpRef ext_write_char(Interp* interp, SExpRef args) { + int len = LENGTH(args); + if (len < 1 || len > 2) return new_error(interp, "write-char: wrong args num.\n"); + + if (VALTYPE(CAR(args)) != kCharSExp) + return new_error(interp, "write-char: first arg must be char.\n"); + + char c = REF(CAR(args))->character; + + FILE *fp = get_output_stream(interp, CDR(args), "write-char"); // CDR is the rest of args + if (!fp) return NIL; + + fputc(c, fp); + return NIL; +} + +// (write-obj obj [stream]) +static SExpRef ext_write_obj(Interp* interp, SExpRef args) { + int len = LENGTH(args); + if (len < 1 || len > 2) return new_error(interp, "write-obj: wrong args num.\n"); + + SExpRef obj = CAR(args); + FILE *fp = get_output_stream(interp, CDR(args), "write-obj"); + if (!fp) return NIL; + + lisp_print(interp, obj, fp); + return NIL; +} + +static void stream_free(void *vself) { + LispStream *self = (LispStream*)vself; + if (self->should_close && self->fp) { + fclose(self->fp); + } + free(self); +} + +static void stream_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) { + (void)interp; + (void)gcstack; + (void)vself; +} + +int bamboo_lisp_ext_init(Interp *interp) { + bamboo_lisp_stream_meta.type = STREAM_TYPEID; + bamboo_lisp_stream_meta.free = &stream_free; + bamboo_lisp_stream_meta.gcmark = &stream_gcmark; + + Interp_add_userfunc(interp, "stream?", &ext_is_stream); + Interp_add_userfunc(interp, "open-file", &ext_open_file); + Interp_add_userfunc(interp, "stream-close", &ext_stream_close); + Interp_add_userfunc(interp, "read-char", &ext_read_char); + Interp_add_userfunc(interp, "read-integer", &ext_read_integer); + Interp_add_userfunc(interp, "read-number", &ext_read_number); + Interp_add_userfunc(interp, "read-line", &ext_read_line); + Interp_add_userfunc(interp, "lines", &ext_lines); + Interp_add_userfunc(interp, "write-char", &ext_write_char); + Interp_add_userfunc(interp, "write-obj", &ext_write_obj); + + return 1; +} \ No newline at end of file diff --git a/exts/io/main.c b/exts/io/main.c deleted file mode 100644 index e69de29..0000000 diff --git a/exts/test_input.txt b/exts/test_input.txt new file mode 100644 index 0000000..c5b2a08 --- /dev/null +++ b/exts/test_input.txt @@ -0,0 +1,3 @@ +abc123 +ascx +asc \ No newline at end of file diff --git a/exts/tests/test_dict.lisp b/exts/tests/test_dict.lisp new file mode 100644 index 0000000..501faba --- /dev/null +++ b/exts/tests/test_dict.lisp @@ -0,0 +1,17 @@ +(loadext "./dict.so") + +(defvar d (make-dict)) + +(dict-set d "a" 1) +(dict-set d "b" 2) +(dict-set d "c" 3) + +(assert (equal? (dict-keys d) (list "a" "b" "c"))) +(assert (equal? (dict-get d "a") 1)) +(assert (equal? (dict-get d "b") 2)) +(dict-set d "a" 5) +(assert (equal? (dict-get d "a") 5)) + +(dict-remove d "b") + +(assert (equal? (dict-keys d) (list "a" "c"))) \ No newline at end of file diff --git a/exts/tests/test_io.lisp b/exts/tests/test_io.lisp new file mode 100644 index 0000000..76b91ce --- /dev/null +++ b/exts/tests/test_io.lisp @@ -0,0 +1,15 @@ +(loadext "io.so") + +(defvar fp (open-file "./test_input.txt" "r")) +(read-char fp) +(read-char fp) +(read-char fp) +(stream-close fp) + +(defvar fp (open-file "./test_input.txt" "r")) +(read-line fp) +(stream-close fp) + +(defvar fp (open-file "./test_input.txt" "r")) +(lines fp) +(stream-close fp) \ No newline at end of file diff --git a/exts/vector.c b/exts/vector.c new file mode 100644 index 0000000..960cf5d --- /dev/null +++ b/exts/vector.c @@ -0,0 +1,129 @@ +#include +#include + +#define VECTOR_TYPEID "ext.core.vector" + +LispUserdataMeta bamboo_lisp_array_meta; + +static bool is_vector_impl(Interp *interp, SExpRef vec) { + if (VALTYPE(vec) == kUserDataSExp && strcmp(VECTOR_TYPEID, REF(vec)->userdata_meta->type) == 0) { + return true; + } + return false; +} + +static SExpRef is_vector(Interp* interp, SExpRef args) { + if (LENGTH(args) != 1) return new_error(interp, "vector?: wrongs args num.\n"); + return new_boolean(interp, is_vector_impl(interp, CAR(args))); +} + +static SExpRef make_vector(Interp* interp, SExpRef args) { + SExpRef ret = new_sexp(interp); + REF(ret)->type = kUserDataSExp; + REF(ret)->userdata_meta = &bamboo_lisp_array_meta; + SExpRefVector *data = malloc(sizeof(SExpRefVector)); + SExpRefVector_init(data); + REF(ret)->userdata = data; + return ret; +} + +static SExpRef ext_vector_ref(Interp* interp, SExpRef args) { + if (LENGTH(args) != 2) return new_error(interp, "vector-ref: wrong args num.\n"); + if (!is_vector_impl(interp, CAR(args)) + || REF(CADR(args))->type != kIntegerSExp) { + return new_error(interp, "vector-ref: wrong type.\n"); + } + int n = REF(CADR(args))->integer; + SExpRefVector *vec = REF(CAR(args))->userdata; + if (n >= SExpRefVector_len(vec)) return new_error(interp, "vector-ref: out of bound.\n"); + SExpRef ret = new_sexp(interp); + return *SExpRefVector_ref(vec, n); +} + +static SExpRef ext_vector_append(Interp* interp, SExpRef args) { + if (LENGTH(args) != 2) return new_error(interp, "vector-append: wrong args num.\n"); + if (!is_vector_impl(interp, CAR(args))) return new_error(interp, "vector-append: first arg not a vector.\n"); + + SExpRefVector *vec = REF(CAR(args))->userdata; + SExpRef elem = CADR(args); + SExpRefVector_push_back(vec, elem); + return NIL; +} + +static SExpRef ext_vector_insert(Interp* interp, SExpRef args) { + if (LENGTH(args) != 3) return new_error(interp, "vector-insert: wrong args num.\n"); + if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp) + return new_error(interp, "vector-insert: wrong types.\n"); + + int pos = REF(CADR(args))->integer; + SExpRefVector *vec = REF(CAR(args))->userdata; + SExpRef elem = CADDR(args); + SExpRefVector_insert_before(vec, pos, elem); + return NIL; +} + +static SExpRef ext_vector_delete(Interp* interp, SExpRef args) { + if (LENGTH(args) != 2) return new_error(interp, "vector-remove: wrong args num.\n"); + if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp) + return new_error(interp, "vector-remove: wrong types.\n"); + + int pos = REF(CADR(args))->integer; + SExpRefVector *vec = REF(CAR(args))->userdata; + if (pos >= SExpRefVector_len(vec)) return new_error(interp, "vector-remove: out of bound.\n"); + SExpRefVector_remove(vec, pos); + return NIL; +} + +static SExpRef ext_vector_length(Interp* interp, SExpRef args) { + if (LENGTH(args) != 1) return new_error(interp, "vector-length: wrong args num.\n"); + if (!is_vector_impl(interp, CAR(args))) return new_error(interp, "vector-length: not a vector.\n"); + + SExpRefVector *vec = REF(CAR(args))->userdata; + return new_integer(interp, SExpRefVector_len(vec)); +} + +static SExpRef ext_vector_set(Interp* interp, SExpRef args) { + if (LENGTH(args) != 3) return new_error(interp, "vector-set: wrong args num.\n"); + if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp) + return new_error(interp, "vector-set: wrong types.\n"); + + int pos = REF(CADR(args))->integer; + SExpRefVector *vec = REF(CAR(args))->userdata; + if (pos >= SExpRefVector_len(vec)) return new_error(interp, "vector-set: out of bound.\n"); + + *SExpRefVector_ref(vec, pos) = CADDR(args); + return NIL; +} + +static void ext_vector_free(void *vself) { + SExpRefVector *self = vself; + SExpRefVector_free(self); + free(self); +} + +static void ext_vector_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) { + SExpRefVector *vec = (SExpRefVector *)vself; + int vecsize = SExpRefVector_len(vec); + for (int i = 0; i < vecsize; ++i) { + SExpPtr child = REF(*SExpRefVector_ref(vec, i)); + if (child && !child->marked) { + SExpPtrVector_push_back(gcstack, child); + } + } +} + +int bamboo_lisp_ext_init(Interp *interp) { + bamboo_lisp_array_meta.type = VECTOR_TYPEID; + bamboo_lisp_array_meta.free = &ext_vector_free; + bamboo_lisp_array_meta.gcmark = &ext_vector_gcmark; + + Interp_add_userfunc(interp, "vector?", &is_vector); + Interp_add_userfunc(interp, "make-vector", &make_vector); + Interp_add_userfunc(interp, "vector-ref", &ext_vector_ref); + Interp_add_userfunc(interp, "vector-append", &ext_vector_append); + Interp_add_userfunc(interp, "vector-insert", &ext_vector_insert); + Interp_add_userfunc(interp, "vector-remove", &ext_vector_delete); + Interp_add_userfunc(interp, "vector-length", &ext_vector_length); + Interp_add_userfunc(interp, "vector-set", &ext_vector_set); + return 1; +} diff --git a/exts/vector/Makefile b/exts/vector/Makefile deleted file mode 100644 index e69de29..0000000 diff --git a/exts/vector/main.c b/exts/vector/main.c deleted file mode 100644 index 3261fed..0000000 --- a/exts/vector/main.c +++ /dev/null @@ -1,129 +0,0 @@ -#include -#include - -#define VECTOR_TYPEID "ext.core.vector" - -LispUserdataMeta bamboo_lisp_array_meta; - -static bool is_vector_impl(Interp *interp, SExpRef vec) { - if (VALTYPE(vec) == kUserDataSExp && strcmp(VECTOR_TYPEID, REF(vec)->userdata_meta->type) == 0) { - return true; - } - return false; -} - -static SExpRef is_vector(Interp* interp, SExpRef args) { - if (LENGTH(args) != 1) return new_error(interp, "vector?: wrongs args num.\n"); - return new_boolean(interp, is_vector_impl(interp, CAR(args))); -} - -static SExpRef make_vector(Interp* interp, SExpRef args) { - SExpRef ret = new_sexp(interp); - REF(ret)->type = kUserDataSExp; - REF(ret)->userdata_meta = &bamboo_lisp_array_meta; - SExpRefVector *data = malloc(sizeof(SExpRefVector)); - SExpRefVector_init(data); - REF(ret)->userdata = data; - return ret; -} - -static SExpRef vector_ref(Interp* interp, SExpRef args) { - if (LENGTH(args) != 2) return new_error(interp, "vector-ref: wrong args num.\n"); - if (!is_vector_impl(interp, CAR(args)) - || REF(CADR(args))->type != kIntegerSExp) { - return new_error(interp, "vector-ref: wrong type.\n"); - } - int n = REF(CADR(args))->integer; - SExpRefVector *vec = REF(CAR(args))->userdata; - if (n >= SExpRefVector_len(vec)) return new_error(interp, "vector-ref: out of bound.\n"); - SExpRef ret = new_sexp(interp); - return *SExpRefVector_ref(vec, n); -} - -static SExpRef vector_append(Interp* interp, SExpRef args) { - if (LENGTH(args) != 2) return new_error(interp, "vector-append: wrong args num.\n"); - if (!is_vector_impl(interp, CAR(args))) return new_error(interp, "vector-append: first arg not a vector.\n"); - - SExpRefVector *vec = REF(CAR(args))->userdata; - SExpRef elem = CADR(args); - SExpRefVector_push_back(vec, elem); - return NIL; -} - -static SExpRef vector_insert(Interp* interp, SExpRef args) { - if (LENGTH(args) != 3) return new_error(interp, "vector-insert: wrong args num.\n"); - if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp) - return new_error(interp, "vector-insert: wrong types.\n"); - - int pos = REF(CADR(args))->integer; - SExpRefVector *vec = REF(CAR(args))->userdata; - SExpRef elem = CADDR(args); - SExpRefVector_insert_before(vec, pos, elem); - return NIL; -} - -static SExpRef vector_delete(Interp* interp, SExpRef args) { - if (LENGTH(args) != 2) return new_error(interp, "vector-remove: wrong args num.\n"); - if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp) - return new_error(interp, "vector-remove: wrong types.\n"); - - int pos = REF(CADR(args))->integer; - SExpRefVector *vec = REF(CAR(args))->userdata; - if (pos >= SExpRefVector_len(vec)) return new_error(interp, "vector-remove: out of bound.\n"); - SExpRefVector_remove(vec, pos); - return NIL; -} - -static SExpRef vector_length(Interp* interp, SExpRef args) { - if (LENGTH(args) != 1) return new_error(interp, "vector-length: wrong args num.\n"); - if (!is_vector_impl(interp, CAR(args))) return new_error(interp, "vector-length: not a vector.\n"); - - SExpRefVector *vec = REF(CAR(args))->userdata; - return new_integer(interp, SExpRefVector_len(vec)); -} - -static SExpRef vector_set(Interp* interp, SExpRef args) { - if (LENGTH(args) != 3) return new_error(interp, "vector-set: wrong args num.\n"); - if (!is_vector_impl(interp, CAR(args)) || REF(CADR(args))->type != kIntegerSExp) - return new_error(interp, "vector-set: wrong types.\n"); - - int pos = REF(CADR(args))->integer; - SExpRefVector *vec = REF(CAR(args))->userdata; - if (pos >= SExpRefVector_len(vec)) return new_error(interp, "vector-set: out of bound.\n"); - - *SExpRefVector_ref(vec, pos) = CADDR(args); - return NIL; -} - -static void vector_free(void *vself) { - SExpRefVector *self = vself; - SExpRefVector_free(self); - free(self); -} - -static void vector_gcmark(Interp *interp, SExpPtrVector *gcstack, void *vself) { - SExpRefVector *vec = (SExpRefVector *)vself; - int vecsize = SExpRefVector_len(vec); - for (int i = 0; i < vecsize; ++i) { - SExpPtr child = REF(*SExpRefVector_ref(vec, i)); - if (child && !child->marked) { - SExpPtrVector_push_back(gcstack, child); - } - } -} - -int bamboo_lisp_ext_init(Interp *interp) { - bamboo_lisp_array_meta.type = VECTOR_TYPEID; - bamboo_lisp_array_meta.free = &vector_free; - bamboo_lisp_array_meta.gcmark = &vector_gcmark; - - Interp_add_userfunc(interp, "vector?", &is_vector); - Interp_add_userfunc(interp, "make-vector", &make_vector); - Interp_add_userfunc(interp, "vector-ref", &vector_ref); - Interp_add_userfunc(interp, "vector-append", &vector_append); - Interp_add_userfunc(interp, "vector-insert", &vector_insert); - Interp_add_userfunc(interp, "vector-remove", &vector_delete); - Interp_add_userfunc(interp, "vector-length", &vector_length); - Interp_add_userfunc(interp, "vector-set", &vector_set); - return 1; -} diff --git a/exts/vector/test.lisp b/exts/vector/test.lisp deleted file mode 100644 index e69de29..0000000 -- cgit v1.0