From dab2284cd5aae14bb166c90105a8e7b1bd290dcd Mon Sep 17 00:00:00 2001 From: Mistivia Date: Mon, 14 Jul 2025 19:52:37 +0800 Subject: add vector --- 3rdparty/algds | 2 +- Readme.md | 3 +- src/interp.c | 21 +++++++++ src/sexp.h | 12 ++--- src/vector.c | 128 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/vector.h | 8 ++++ tests/test.lisp | 2 + tests/vector.lisp | 20 +++++++++ 8 files changed, 187 insertions(+), 9 deletions(-) create mode 100644 src/vector.c create mode 100644 src/vector.h create mode 100644 tests/vector.lisp diff --git a/3rdparty/algds b/3rdparty/algds index 16c7734..a8764a2 160000 --- a/3rdparty/algds +++ b/3rdparty/algds @@ -1 +1 @@ -Subproject commit 16c7734be15f6f09fa732297a1fecc1076fa9df7 +Subproject commit a8764a20f355fd8fb7b03978d754d1cbd48d0a88 diff --git a/Readme.md b/Readme.md index 1a0ca59..d409fce 100644 --- a/Readme.md +++ b/Readme.md @@ -30,13 +30,12 @@ To keep simplicity, Bamboo Lisp is a VERY SLOW tree-walking interpreter. The per Init submodule: ```bash -git submodule init --recursive +git submodule update --init --recursive ``` Debug: ```bash -git submodule init --recursive make ``` diff --git a/src/interp.c b/src/interp.c index d092e1f..b1d43fa 100644 --- a/src/interp.c +++ b/src/interp.c @@ -12,6 +12,8 @@ #include "parser.h" #include "prelude.h" +#include "vector.h" + #define BUFSIZE 1024 bool SExpRef_eq(SExpRef a, SExpRef b) { @@ -240,6 +242,9 @@ void Interp_init(Interp *self) { Interp_add_userfunc(self, "_gcstat", builtin_gcstat); Interp_add_userfunc(self, "_alwaysgc", builtin_alwaysgc); + // extentions + bamboo_lisp_init_vector(self); + SExpRef ret = Interp_eval_string(self, bamboo_lisp_prelude); Interp *interp = self; if (VALTYPE(ret) == kErrSignal) { @@ -326,6 +331,11 @@ void Interp_free(Interp *self) { if (obj->type == kStringSExp) { free((void*)obj->str); } + if (obj->type == kUserDataSExp) { + if (obj->userdata_meta && obj->userdata_meta->free) { + (*obj->userdata_meta->free)(obj->userdata); + } + } } for (String2IntHashTableIter iter = String2IntHashTable_begin(&self->symbols); iter != NULL; @@ -416,6 +426,10 @@ void Interp_gc(Interp *interp, SExpRef tmproot) { if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child); child = REF(obj->tailcall.fn); if (child && !child->marked) SExpPtrVector_push_back(&gcstack, child); + } else if (obj->type == kUserDataSExp) { + if (obj->userdata_meta && obj->userdata_meta->gcmark) { + (*obj->userdata_meta->gcmark)(interp, &gcstack, obj->userdata); + } } } SExpPtrVector_free(&gcstack); @@ -429,6 +443,11 @@ void Interp_gc(Interp *interp, SExpRef tmproot) { if (obj->type == kSymbolSExp) continue; if (obj->type == kEmptySExp) continue; if (obj->type == kStringSExp) free((void*)obj->str); + if (obj->type == kUserDataSExp) { + if (obj->userdata_meta && obj->userdata_meta->free) { + (*obj->userdata_meta->free)(obj->userdata); + } + } obj->type = kEmptySExp; IntVector_push_back(&interp->empty_space, i); } @@ -528,6 +547,8 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i str_builder_append(sb, ""); } else if (pe->type == kTailcallSExp) { str_builder_append(sb, ""); + } else if (pe->type == kUserDataSExp) { + str_builder_append(sb, ""); } else if (pe->type == kPairSExp) { if (Int2IntHashTable_find(visited, val.idx) != NULL) { str_builder_append(sb, "<%d>", val.idx); diff --git a/src/sexp.h b/src/sexp.h index 4aec76d..d8d2dc9 100644 --- a/src/sexp.h +++ b/src/sexp.h @@ -78,10 +78,13 @@ typedef enum { VECTOR_DEF(SExpRef); +typedef SExp *SExpPtr; +VECTOR_DEF(SExpPtr); + typedef struct { - SExpRef type; + const char *type; void (*free)(void *self); - void (*gcmark)(SExpRefVector *gcstack, void *self); + void (*gcmark)(Interp *interp, SExpPtrVector *gcstack, void *self); } LispUserdataMeta; struct sexp { @@ -94,7 +97,7 @@ struct sexp { char character; const char *str; struct { - const void *userdata; + void *userdata; LispUserdataMeta *userdata_meta; }; SExpPair pair; @@ -109,15 +112,12 @@ struct sexp { }; }; -typedef SExp *SExpPtr; - void SExp_show(SExp self, FILE* fp); void SExpRef_show(SExpRef self, FILE* fp); void SExpPtr_show(SExpPtr self, FILE* fp); VECTOR_DEF(SExp); -VECTOR_DEF(SExpPtr); #endif diff --git a/src/vector.c b/src/vector.c new file mode 100644 index 0000000..453800b --- /dev/null +++ b/src/vector.c @@ -0,0 +1,128 @@ +#include "vector.h" +#include "interp.h" +#include "sexp.h" + +LispUserdataMeta bamboo_lisp_array_meta; + +static bool is_vector_impl(Interp *interp, SExpRef vec) { + if (VALTYPE(vec) == kUserDataSExp && strcmp("vector", 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); + } + } +} + + +void bamboo_lisp_init_vector(Interp *interp) { + bamboo_lisp_array_meta.type = "vector"; + 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); +} diff --git a/src/vector.h b/src/vector.h new file mode 100644 index 0000000..34113d1 --- /dev/null +++ b/src/vector.h @@ -0,0 +1,8 @@ +#ifndef BAMBOO_LISP_VECTOR_H_ +#define BAMBOO_LISP_VECTOR_H_ + +#include "interp.h" + +void bamboo_lisp_init_vector(Interp *interp); + +#endif diff --git a/tests/test.lisp b/tests/test.lisp index 4013888..241f69c 100644 --- a/tests/test.lisp +++ b/tests/test.lisp @@ -22,6 +22,7 @@ (test-module type) (test-module char) (test-module bitwise) +(test-module vector) (princ "\n\nTest with intensive GC:\n\n") (_alwaysgc #t) @@ -43,5 +44,6 @@ (test-module type) (test-module char) (test-module bitwise) +(test-module vector) (exit) diff --git a/tests/vector.lisp b/tests/vector.lisp new file mode 100644 index 0000000..9146168 --- /dev/null +++ b/tests/vector.lisp @@ -0,0 +1,20 @@ +(assert (vector? (make-vector))) +(assert (not (vector? 1))) + +(defvar v (make-vector)) + +(assert (= 0 (vector-length v))) +(assert-error (vector-ref v 0)) + +(vector-append v 0) +(vector-append v "123") +(vector-append v 1.2) + +(assert (= 3 (vector-length v))) + +(vector-insert v 1 99) + +(assert (equal? (vector-ref v 0) 0)) +(assert (equal? (vector-ref v 1) 99)) +(assert (equal? (vector-ref v 2) "123")) +(assert (equal? (vector-ref v 3) 1.2)) -- cgit v1.0