add io ext

1 files changed, 182 insertions, 0 deletions

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 <string.h>
+#include <stdlib.h>
+
+#include <algds/tree_map.h>
+#include <algds/basic_traits.h>
+#include <bamboo_lisp/interp.h>
+#include <bamboo_lisp/sexp.h>
+
+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