ref: 14c196a5da48284123d615418c80b6fbc87d7f46
dir: /table.c/
#include "flisp.h" #include "equalhash.h" #include "cvalues.h" #include "types.h" #include "print.h" #include "table.h" static void print_htable(value_t v, ios_t *f) { htable_t *h = cvalue_data(v); size_t i; int first = 1; fl_print_str("#table(", f); for(i = 0; i < h->size; i += 2){ if(h->table[i+1] != HT_NOTFOUND){ if(!first) fl_print_str(" ", f); fl_print_child(f, (value_t)h->table[i]); fl_print_chr(' ', f); fl_print_child(f, (value_t)h->table[i+1]); first = 0; } } fl_print_chr(')', f); } static void print_traverse_htable(value_t self) { htable_t *h = cvalue_data(self); size_t i; for(i = 0; i < h->size; i += 2){ if(h->table[i+1] != HT_NOTFOUND){ print_traverse((value_t)h->table[i]); print_traverse((value_t)h->table[i+1]); } } } static void free_htable(value_t self) { htable_t *h = cvalue_data(self); htable_free(h); } static void relocate_htable(value_t oldv, value_t newv) { htable_t *oldh = cvalue_data(oldv); htable_t *h = cvalue_data(newv); if(oldh->table == &oldh->_space[0]) h->table = &h->_space[0]; size_t i; for(i = 0; i < h->size; i++){ if(h->table[i] != HT_NOTFOUND) h->table[i] = (void*)relocate((value_t)h->table[i]); } } static cvtable_t table_vtable = { print_htable, relocate_htable, free_htable, print_traverse_htable, }; static int ishashtable(value_t v) { return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == FL(tabletype); } BUILTIN("table?", tablep) { argcount(nargs, 1); return ishashtable(args[0]) ? FL(t) : FL(f); } static htable_t * totable(value_t v) { if(!ishashtable(v)) type_error("table", v); return cvalue_data(v); } BUILTIN("table", table) { size_t cnt = (size_t)nargs; if(cnt & 1) lerrorf(FL(ArgError), "arguments must come in pairs"); value_t nt; // prevent small tables from being added to finalizer list if(cnt <= HT_N_INLINE) nt = cvalue_nofinalizer(FL(tabletype), sizeof(htable_t)); else nt = cvalue(FL(tabletype), 2*sizeof(void*)); htable_t *h = cvalue_data(nt); htable_new(h, cnt/2); size_t i; value_t k = FL(Nil), arg; FOR_ARGS(i, 0, arg, args){ if(i & 1) equalhash_put(h, (void*)k, (void*)arg); else k = arg; } if(cnt <= HT_N_INLINE && h->table != &h->_space[0]){ cvalue_t *cv = ptr(nt); add_finalizer(cv); cv->len = 2*sizeof(void*); } return nt; } // (put! table key value) BUILTIN("put!", put) { argcount(nargs, 3); htable_t *h = totable(args[0]); void **table0 = h->table; equalhash_put(h, (void*)args[1], (void*)args[2]); // register finalizer if we outgrew inline space if(table0 == &h->_space[0] && h->table != &h->_space[0]){ cvalue_t *cv = ptr(args[0]); add_finalizer(cv); cv->len = 2*sizeof(void*); } return args[0]; } static void key_error(value_t key) { lerrorf(fl_list2(FL(KeyError), key), "key not found"); } // (get table key [default]) BUILTIN("get", get) { if(nargs != 3) argcount(nargs, 2); htable_t *h = totable(args[0]); value_t v = (value_t)equalhash_get(h, (void*)args[1]); if(v == (value_t)HT_NOTFOUND){ if(nargs == 3) return args[2]; key_error(args[1]); } return v; } // (has? table key) BUILTIN("has?", has) { argcount(nargs, 2); htable_t *h = totable(args[0]); return equalhash_has(h, (void*)args[1]) ? FL(t) : FL(f); } // (del! table key) BUILTIN("del!", del) { argcount(nargs, 2); htable_t *h = totable(args[0]); if(!equalhash_remove(h, (void*)args[1])) key_error(args[1]); return args[0]; } BUILTIN("table-foldl", table_foldl) { argcount(nargs, 3); value_t f = args[0], zero = args[1], t = args[2]; htable_t *h = totable(t); size_t i, n = h->size; void **table = h->table; fl_gc_handle(&f); fl_gc_handle(&zero); fl_gc_handle(&t); for(i = 0; i < n; i += 2){ if(table[i+1] != HT_NOTFOUND){ zero = fl_applyn(3, f, (value_t)table[i], (value_t)table[i+1], zero); // reload pointer h = cvalue_data(t); if(h->size != n) lerrorf(FL(EnumerationError), "table modified"); table = h->table; } } fl_free_gc_handles(3); return zero; } void table_init(void) { FL(tablesym) = symbol("table", false); FL(tabletype) = define_opaque_type(FL(tablesym), sizeof(htable_t), &table_vtable, nil); }