diff options
| -rw-r--r-- | Makefile | 4 | ||||
| -rw-r--r-- | ext_example/vector.c (renamed from exts/vector.c) | 0 | ||||
| -rw-r--r-- | exts/dict.c | 165 | ||||
| -rw-r--r-- | tests/vector.lisp | 2 |
4 files changed, 2 insertions, 169 deletions
@@ -16,7 +16,7 @@ installdir = /usr/local/lib/ src = $(shell find ./ -maxdepth 1 -name '*.c' -not -name 'main.c') obj = $(src:.c=.o) -extsrc = $(shell find ./exts/ -maxdepth 1 -name '*.c') +extsrc = $(shell find ./ext_example/ -maxdepth 1 -name '*.c') extobj = $(extsrc:.c=.so) tests=$(shell ls tests/*.c) @@ -31,8 +31,6 @@ install: bamboo-lisp libbamboo-lisp.so sudo cp libbamboo-lisp.so $(installdir) sudo mkdir -p /usr/local/include/bamboo_lisp sudo cp *.h /usr/local/include/bamboo_lisp/ - sudo mkdir -p /usr/local/share/bamboo-lisp/exts/ - sudo cp exts/*.so /usr/local/share/bamboo-lisp/exts/ prelude.c: prelude.lisp cat prelude.lisp | python scripts/genprelude.py > prelude.c diff --git a/exts/vector.c b/ext_example/vector.c index a67a504..a67a504 100644 --- a/exts/vector.c +++ b/ext_example/vector.c diff --git a/exts/dict.c b/exts/dict.c deleted file mode 100644 index 02b7d4e..0000000 --- a/exts/dict.c +++ /dev/null @@ -1,165 +0,0 @@ -#include <string.h> -#include <stdlib.h> -#include <algds/tree_map.h> -#include <algds/basic_traits.h> - -#include "interp.h" -#include "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 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/tests/vector.lisp b/tests/vector.lisp index de22a89..10afde4 100644 --- a/tests/vector.lisp +++ b/tests/vector.lisp @@ -1,4 +1,4 @@ -(loadext "exts/vector.so") +(loadext "ext_example/vector.so") (assert (vector? (make-vector))) (assert (not (vector? 1))) |