add io ext

1 files changed, 129 insertions, 0 deletions

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 <bamboo_lisp/interp.h>
+#include <bamboo_lisp/sexp.h>
+
+#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;
+}