conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'khash-kvec2'

This commit is contained in:
Yuichi Nishiwaki 2015-06-25 08:23:09 +09:00
parent 6b15304d85 9db8b33c61
commit cfd73aae71
22 changed files with 708 additions and 826 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
extlib/benz/bool.c
View File

@ -4,89 +4,84 @@
#include "picrin.h"
static bool
str_equal_p(pic_state *pic, struct pic_string *str1, struct pic_string *str2)
{
return pic_str_cmp(pic, str1, str2) == 0;
}
KHASH_DECLARE(m, void *, int)
KHASH_DEFINE2(m, void *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal)
static bool
blob_equal_p(struct pic_blob *blob1, struct pic_blob *blob2)
{
size_t i;
if (blob1->len != blob2->len) {
return false;
}
for (i = 0; i < blob1->len; ++i) {
if (blob1->data[i] != blob2->data[i])
return false;
}
return true;
}
static bool
internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *xh, bool xh_initted_p)
internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, khash_t(m) *h)
{
pic_value local = pic_nil_value();
size_t c;
size_t c = 0;
if (depth > 10) {
if (depth > 200) {
pic_errorf(pic, "Stack overflow in equal\n");
}
if (pic_pair_p(x) || pic_vec_p(x)) {
if (! xh_initted_p) {
xh_init_ptr(xh, 0);
xh_initted_p = true;
}
if (xh_get_ptr(xh, pic_obj_ptr(x)) != NULL) {
int ret;
kh_put(m, h, pic_obj_ptr(x), &ret);
if (ret != 0) {
return true; /* `x' was seen already. */
} else {
xh_put_ptr(xh, pic_obj_ptr(x), NULL);
}
}
}
c = 0;
LOOP:
if (pic_eqv_p(x, y))
if (pic_eqv_p(x, y)) {
return true;
if (pic_type(x) != pic_type(y))
}
if (pic_type(x) != pic_type(y)) {
return false;
}
switch (pic_type(x)) {
case PIC_TT_STRING:
return str_equal_p(pic, pic_str_ptr(x), pic_str_ptr(y));
case PIC_TT_ID: {
struct pic_id *id1, *id2;
case PIC_TT_BLOB:
return blob_equal_p(pic_blob_ptr(x), pic_blob_ptr(y));
id1 = pic_id_ptr(x);
id2 = pic_id_ptr(y);
return pic_resolve(pic, id1->var, id1->env) == pic_resolve(pic, id2->var, id2->env);
}
case PIC_TT_STRING: {
return pic_str_cmp(pic, pic_str_ptr(x), pic_str_ptr(y)) == 0;
}
case PIC_TT_BLOB: {
pic_blob *blob1, *blob2;
size_t i;
blob1 = pic_blob_ptr(x);
blob2 = pic_blob_ptr(y);
if (blob1->len != blob2->len) {
return false;
}
for (i = 0; i < blob1->len; ++i) {
if (blob1->data[i] != blob2->data[i])
return false;
}
return true;
}
case PIC_TT_PAIR: {
if (! internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, h))
return false;
/* Floyd's cycle-finding algorithm */
if (pic_nil_p(local)) {
local = x;
}
if (internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, xh, xh_initted_p)) {
x = pic_cdr(pic, x);
y = pic_cdr(pic, y);
c++;
if (c == 2) {
c = 0;
local = pic_cdr(pic, local);
if (pic_eq_p(local, x)) {
return true;
}
x = pic_cdr(pic, x);
y = pic_cdr(pic, y);
c++;
if (c == 2) {
c = 0;
local = pic_cdr(pic, local);
if (pic_eq_p(local, x)) {
return true;
}
goto LOOP;
} else {
return false;
}
goto LOOP; /* tail-call optimization */
}
case PIC_TT_VECTOR: {
size_t i;
@ -99,19 +94,11 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
return false;
}
for (i = 0; i < u->len; ++i) {
if (! internal_equal_p(pic, u->data[i], v->data[i], depth + 1, xh, xh_initted_p))
if (! internal_equal_p(pic, u->data[i], v->data[i], depth + 1, h))
return false;
}
return true;
}
case PIC_TT_ID: {
struct pic_id *id1, *id2;
id1 = pic_id_ptr(x);
id2 = pic_id_ptr(y);
return pic_resolve(pic, id1->var, id1->env) == pic_resolve(pic, id2->var, id2->env);
}
default:
return false;
}
@ -120,9 +107,11 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
bool
pic_equal_p(pic_state *pic, pic_value x, pic_value y)
{
xhash ht;
khash_t(m) h;
return internal_equal_p(pic, x, y, 0, &ht, false);
kh_init(m, &h);
return internal_equal_p(pic, x, y, 0, &h);
}
static pic_value

133
extlib/benz/codegen.c
View File

@ -11,13 +11,14 @@
static pic_sym *
lookup(pic_state PIC_UNUSED(*pic), pic_value var, struct pic_env *env)
{
xh_entry *e;
khiter_t it;
assert(pic_var_p(var));
while (env != NULL) {
if ((e = xh_get_ptr(&env->map, pic_ptr(var))) != NULL) {
return xh_val(e, pic_sym *);
it = kh_get(env, &env->map, pic_ptr(var));
if (it != kh_end(&env->map)) {
return kh_val(&env->map, it);
}
env = env->up;
}
@ -330,9 +331,9 @@ pic_expand(pic_state *pic, pic_value expr, struct pic_env *env)
return v;
}
typedef xvect_t(pic_sym *) xvect;
typedef kvec_t(pic_sym *) svec_t;
#define xv_push_sym(v, x) xv_push(pic_sym *, (v), (x))
#define kv_push_sym(v, x) kv_push(pic_sym *, (v), (x))
/**
* scope object
@ -341,7 +342,7 @@ typedef xvect_t(pic_sym *) xvect;
typedef struct analyze_scope {
int depth;
bool varg;
xvect args, locals, captures; /* rest args variable is counted as a local */
svec_t args, locals, captures; /* rest args variable is counted as a local */
pic_value defer;
struct analyze_scope *up;
} analyze_scope;
@ -363,7 +364,7 @@ new_analyze_state(pic_state *pic)
{
analyze_state *state;
pic_sym *sym;
xh_entry *it;
khiter_t it;
state = pic_malloc(pic, sizeof(analyze_state));
state->pic = pic;
@ -373,7 +374,7 @@ new_analyze_state(pic_state *pic)
push_scope(state, pic_nil_value());
pic_dict_for_each (sym, pic->globals, it) {
xv_push_sym(state->scope->locals, sym);
kv_push_sym(state->scope->locals, sym);
}
return state;
@ -387,7 +388,7 @@ destroy_analyze_state(analyze_state *state)
}
static bool
analyze_args(pic_state *pic, pic_value formals, bool *varg, xvect *args, xvect *locals)
analyze_args(pic_state *pic, pic_value formals, bool *varg, svec_t *args, svec_t *locals)
{
pic_value v, t;
pic_sym *sym;
@ -398,7 +399,7 @@ analyze_args(pic_state *pic, pic_value formals, bool *varg, xvect *args, xvect *
return false;
}
sym = pic_sym_ptr(t);
xv_push_sym(*args, sym);
kv_push_sym(*args, sym);
}
if (pic_nil_p(v)) {
*varg = false;
@ -406,7 +407,7 @@ analyze_args(pic_state *pic, pic_value formals, bool *varg, xvect *args, xvect *
else if (pic_sym_p(v)) {
*varg = true;
sym = pic_sym_ptr(v);
xv_push_sym(*locals, sym);
kv_push_sym(*locals, sym);
}
else {
return false;
@ -422,9 +423,9 @@ push_scope(analyze_state *state, pic_value formals)
analyze_scope *scope = pic_malloc(pic, sizeof(analyze_scope));
bool varg;
xv_init(scope->args);
xv_init(scope->locals);
xv_init(scope->captures);
kv_init(scope->args);
kv_init(scope->locals);
kv_init(scope->captures);
if (analyze_args(pic, formals, &varg, &scope->args, &scope->locals)) {
scope->up = state->scope;
@ -437,9 +438,9 @@ push_scope(analyze_state *state, pic_value formals)
return true;
}
else {
xv_destroy(scope->args);
xv_destroy(scope->locals);
xv_destroy(scope->captures);
kv_destroy(scope->args);
kv_destroy(scope->locals);
kv_destroy(scope->captures);
pic_free(pic, scope);
return false;
}
@ -452,9 +453,9 @@ pop_scope(analyze_state *state)
analyze_scope *scope;
scope = state->scope;
xv_destroy(scope->args);
xv_destroy(scope->locals);
xv_destroy(scope->captures);
kv_destroy(scope->args);
kv_destroy(scope->locals);
kv_destroy(scope->captures);
scope = scope->up;
pic_free(state->pic, state->scope);
@ -467,13 +468,13 @@ lookup_scope(analyze_scope *scope, pic_sym *sym)
size_t i;
/* args */
for (i = 0; i < xv_size(scope->args); ++i) {
if (xv_A(scope->args, i) == sym)
for (i = 0; i < kv_size(scope->args); ++i) {
if (kv_A(scope->args, i) == sym)
return true;
}
/* locals */
for (i = 0; i < xv_size(scope->locals); ++i) {
if (xv_A(scope->locals, i) == sym)
for (i = 0; i < kv_size(scope->locals); ++i) {
if (kv_A(scope->locals, i) == sym)
return true;
}
return false;
@ -484,13 +485,13 @@ capture_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
{
size_t i;
for (i = 0; i < xv_size(scope->captures); ++i) {
if (xv_A(scope->captures, i) == sym) {
for (i = 0; i < kv_size(scope->captures); ++i) {
if (kv_A(scope->captures, i) == sym) {
break;
}
}
if (i == xv_size(scope->captures)) {
xv_push_sym(scope->captures, sym);
if (i == kv_size(scope->captures)) {
kv_push_sym(scope->captures, sym);
}
}
@ -524,7 +525,7 @@ define_var(analyze_state *state, pic_sym *sym)
return;
}
xv_push_sym(scope->locals, sym);
kv_push_sym(scope->locals, sym);
}
static pic_value analyze_node(analyze_state *, pic_value, bool);
@ -648,8 +649,8 @@ analyze_procedure(analyze_state *state, pic_value name, pic_value formals, pic_v
size_t i;
args = pic_nil_value();
for (i = xv_size(scope->args); i > 0; --i) {
pic_push(pic, pic_obj_value(xv_A(scope->args, i - 1)), args);
for (i = kv_size(scope->args); i > 0; --i) {
pic_push(pic, pic_obj_value(kv_A(scope->args, i - 1)), args);
}
varg = scope->varg
@ -662,13 +663,13 @@ analyze_procedure(analyze_state *state, pic_value name, pic_value formals, pic_v
analyze_deferred(state);
locals = pic_nil_value();
for (i = xv_size(scope->locals); i > 0; --i) {
pic_push(pic, pic_obj_value(xv_A(scope->locals, i - 1)), locals);
for (i = kv_size(scope->locals); i > 0; --i) {
pic_push(pic, pic_obj_value(kv_A(scope->locals, i - 1)), locals);
}
captures = pic_nil_value();
for (i = xv_size(scope->captures); i > 0; --i) {
pic_push(pic, pic_obj_value(xv_A(scope->captures, i - 1)), captures);
for (i = kv_size(scope->captures); i > 0; --i) {
pic_push(pic, pic_obj_value(kv_A(scope->captures, i - 1)), captures);
}
pop_scope(state);
@ -1141,7 +1142,7 @@ typedef struct codegen_context {
pic_sym *name;
/* rest args variable is counted as a local */
bool varg;
xvect args, locals, captures;
svec_t args, locals, captures;
/* actual bit code sequence */
pic_code *code;
size_t clen, ccapa;
@ -1262,25 +1263,25 @@ create_activation(codegen_state *state)
pic_state *pic = state->pic;
codegen_context *cxt = state->cxt;
size_t i, n;
xhash regs;
size_t offset;
struct pic_reg *regs;
xh_init_ptr(&regs, sizeof(size_t));
regs = pic_make_reg(pic);
offset = 1;
for (i = 0; i < xv_size(cxt->args); ++i) {
for (i = 0; i < kv_size(cxt->args); ++i) {
n = i + offset;
xh_put_ptr(&regs, xv_A(cxt->args, i), &n);
pic_reg_set(pic, regs, kv_A(cxt->args, i), pic_size_value(n));
}
offset += i;
for (i = 0; i < xv_size(cxt->locals); ++i) {
for (i = 0; i < kv_size(cxt->locals); ++i) {
n = i + offset;
xh_put_ptr(&regs, xv_A(cxt->locals, i), &n);
pic_reg_set(pic, regs, kv_A(cxt->locals, i), pic_size_value(n));
}
for (i = 0; i < xv_size(cxt->captures); ++i) {
n = xh_val(xh_get_ptr(&regs, xv_A(cxt->captures, i)), size_t);
if (n <= xv_size(cxt->args) || (cxt->varg && n == xv_size(cxt->args) + 1)) {
for (i = 0; i < kv_size(cxt->captures); ++i) {
n = (size_t)pic_int(pic_reg_ref(pic, regs, kv_A(cxt->captures, i)));
if (n <= kv_size(cxt->args) || (cxt->varg && n == kv_size(cxt->args) + 1)) {
/* copy arguments to capture variable area */
emit_i(state, OP_LREF, (int)n);
} else {
@ -1288,8 +1289,6 @@ create_activation(codegen_state *state)
emit_n(state, OP_PUSHUNDEF);
}
}
xh_destroy(&regs);
}
static void
@ -1308,18 +1307,18 @@ push_codegen_context(codegen_state *state, pic_value name, pic_value args, pic_v
: pic_sym_ptr(name);
cxt->varg = varg;
xv_init(cxt->args);
xv_init(cxt->locals);
xv_init(cxt->captures);
kv_init(cxt->args);
kv_init(cxt->locals);
kv_init(cxt->captures);
pic_for_each (var, args, it) {
xv_push_sym(cxt->args, pic_sym_ptr(var));
kv_push_sym(cxt->args, pic_sym_ptr(var));
}
pic_for_each (var, locals, it) {
xv_push_sym(cxt->locals, pic_sym_ptr(var));
kv_push_sym(cxt->locals, pic_sym_ptr(var));
}
pic_for_each (var, captures, it) {
xv_push_sym(cxt->captures, pic_sym_ptr(var));
kv_push_sym(cxt->captures, pic_sym_ptr(var));
}
cxt->code = pic_calloc(pic, PIC_ISEQ_SIZE, sizeof(pic_code));
@ -1354,9 +1353,9 @@ pop_codegen_context(codegen_state *state)
irep = (struct pic_irep *)pic_obj_alloc(pic, sizeof(struct pic_irep), PIC_TT_IREP);
irep->name = state->cxt->name;
irep->varg = state->cxt->varg;
irep->argc = (int)xv_size(state->cxt->args) + 1;
irep->localc = (int)xv_size(state->cxt->locals);
irep->capturec = (int)xv_size(state->cxt->captures);
irep->argc = (int)kv_size(state->cxt->args) + 1;
irep->localc = (int)kv_size(state->cxt->locals);
irep->capturec = (int)kv_size(state->cxt->captures);
irep->code = pic_realloc(pic, state->cxt->code, sizeof(pic_code) * state->cxt->clen);
irep->clen = state->cxt->clen;
irep->irep = pic_realloc(pic, state->cxt->irep, sizeof(struct pic_irep *) * state->cxt->ilen);
@ -1367,9 +1366,9 @@ pop_codegen_context(codegen_state *state)
irep->slen = state->cxt->slen;
/* finalize */
xv_destroy(cxt->args);
xv_destroy(cxt->locals);
xv_destroy(cxt->captures);
kv_destroy(cxt->args);
kv_destroy(cxt->locals);
kv_destroy(cxt->captures);
/* destroy context */
cxt = cxt->up;
@ -1389,8 +1388,8 @@ index_capture(codegen_state *state, pic_sym *sym, int depth)
cxt = cxt->up;
}
for (i = 0; i < xv_size(cxt->captures); ++i) {
if (xv_A(cxt->captures, i) == sym)
for (i = 0; i < kv_size(cxt->captures); ++i) {
if (kv_A(cxt->captures, i) == sym)
return (int)i;
}
return -1;
@ -1403,13 +1402,13 @@ index_local(codegen_state *state, pic_sym *sym)
size_t i, offset;
offset = 1;
for (i = 0; i < xv_size(cxt->args); ++i) {
if (xv_A(cxt->args, i) == sym)
for (i = 0; i < kv_size(cxt->args); ++i) {
if (kv_A(cxt->args, i) == sym)
return (int)(i + offset);
}
offset += i;
for (i = 0; i < xv_size(cxt->locals); ++i) {
if (xv_A(cxt->locals, i) == sym)
for (i = 0; i < kv_size(cxt->locals); ++i) {
if (kv_A(cxt->locals, i) == sym)
return (int)(i + offset);
}
return -1;
@ -1462,7 +1461,7 @@ codegen(codegen_state *state, pic_value obj)
name = pic_sym_ptr(pic_list_ref(pic, obj, 1));
if ((i = index_capture(state, name, 0)) != -1) {
emit_i(state, OP_LREF, i + (int)xv_size(cxt->args) + (int)xv_size(cxt->locals) + 1);
emit_i(state, OP_LREF, i + (int)kv_size(cxt->args) + (int)kv_size(cxt->locals) + 1);
return;
}
emit_i(state, OP_LREF, index_local(state, name));
@ -1497,7 +1496,7 @@ codegen(codegen_state *state, pic_value obj)
name = pic_sym_ptr(pic_list_ref(pic, var, 1));
if ((i = index_capture(state, name, 0)) != -1) {
emit_i(state, OP_LSET, i + (int)xv_size(cxt->args) + (int)xv_size(cxt->locals) + 1);
emit_i(state, OP_LSET, i + (int)kv_size(cxt->args) + (int)kv_size(cxt->locals) + 1);
emit_n(state, OP_PUSHUNDEF);
return;
}

3
extlib/benz/data.c
View File

@ -4,11 +4,12 @@ struct pic_data *
pic_data_alloc(pic_state *pic, const pic_data_type *type, void *userdata)
{
struct pic_data *data;
struct pic_dict *storage = pic_make_dict(pic);
data = (struct pic_data *)pic_obj_alloc(pic, sizeof(struct pic_data), PIC_TT_DATA);
data->type = type;
data->data = userdata;
xh_init_str(&data->storage, sizeof(pic_value));
data->storage = storage;
return data;
}

136
extlib/benz/dict.c
View File

@ -4,13 +4,15 @@
#include "picrin.h"
KHASH_DEFINE(dict, pic_sym *, pic_value, kh_ptr_hash_func, kh_ptr_hash_equal)
struct pic_dict *
pic_make_dict(pic_state *pic)
{
struct pic_dict *dict;
dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
xh_init_ptr(&dict->hash, sizeof(pic_value));
kh_init(dict, &dict->hash);
return dict;
}
@ -18,41 +20,50 @@ pic_make_dict(pic_state *pic)
pic_value
pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_sym *key)
{
xh_entry *e;
khash_t(dict) *h = &dict->hash;
khiter_t it;
e = xh_get_ptr(&dict->hash, key);
if (! e) {
it = kh_get(dict, h, key);
if (it == kh_end(h)) {
pic_errorf(pic, "element not found for a key: ~s", pic_obj_value(key));
}
return xh_val(e, pic_value);
return kh_val(h, it);
}
void
pic_dict_set(pic_state PIC_UNUSED(*pic), struct pic_dict *dict, pic_sym *key, pic_value val)
{
xh_put_ptr(&dict->hash, key, &val);
khash_t(dict) *h = &dict->hash;
int ret;
khiter_t it;
it = kh_put(dict, h, key, &ret);
kh_val(h, it) = val;
}
size_t
pic_dict_size(pic_state PIC_UNUSED(*pic), struct pic_dict *dict)
{
return dict->hash.count;
return kh_size(&dict->hash);
}
bool
pic_dict_has(pic_state PIC_UNUSED(*pic), struct pic_dict *dict, pic_sym *key)
{
return xh_get_ptr(&dict->hash, key) != NULL;
return kh_get(dict, &dict->hash, key) != kh_end(&dict->hash);
}
void
pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_sym *key)
{
if (xh_get_ptr(&dict->hash, key) == NULL) {
khash_t(dict) *h = &dict->hash;
khiter_t it;
it = kh_get(dict, h, key);
if (it == kh_end(h)) {
pic_errorf(pic, "no slot named ~s found in dictionary", pic_obj_value(key));
}
xh_del_ptr(&dict->hash, key);
kh_del(dict, h, it);
}
static pic_value
@ -146,43 +157,41 @@ pic_dict_dictionary_map(pic_state *pic)
struct pic_proc *proc;
size_t argc, i;
pic_value *args;
pic_value arg, ret;
xh_entry **it;
pic_value arg_list, ret = pic_nil_value();
pic_get_args(pic, "l*", &proc, &argc, &args);
it = pic_malloc(pic, argc * sizeof(xh_entry));
for (i = 0; i < argc; ++i) {
if (! pic_dict_p(args[i])) {
pic_free(pic, it);
pic_errorf(pic, "expected dict, but got %s", pic_type_repr(pic_type(args[i])));
}
it[i] = xh_begin(&pic_dict_ptr(args[i])->hash);
}
if (argc != 0) {
khiter_t it[argc];
khash_t(dict) *kh[argc];
for (i = 0; i < argc; ++i) {
if (! pic_dict_p(args[i])) {
pic_errorf(pic, "expected dict, but got %s", pic_type_repr(pic_type(args[i])));
}
kh[i] = &pic_dict_ptr(args[i])->hash;
it[i] = kh_begin(kh[i]);
}
pic_try {
ret = pic_nil_value();
do {
arg = pic_nil_value();
arg_list = pic_nil_value();
for (i = 0; i < argc; ++i) {
if (it[i] == NULL) {
while (it[i] != kh_end(kh[i])) { /* find next available */
if (kh_exist(kh[i], it[i]))
break;
it[i]++;
}
if (it[i] == kh_end(kh[i])) {
break;
}
pic_push(pic, pic_obj_value(xh_key(it[i], pic_sym *)), arg);
it[i] = xh_next(it[i]);
pic_push(pic, pic_obj_value(kh_key(kh[i], it[i]++)), arg_list);
}
if (i != argc) {
break;
}
pic_push(pic, pic_apply(pic, proc, pic_reverse(pic, arg)), ret);
pic_push(pic, pic_apply(pic, proc, pic_reverse(pic, arg_list)), ret);
} while (1);
}
pic_catch {
pic_free(pic, it);
pic_raise(pic, pic->err);
}
pic_free(pic, it);
return pic_reverse(pic, ret);
}
@ -193,42 +202,41 @@ pic_dict_dictionary_for_each(pic_state *pic)
struct pic_proc *proc;
size_t argc, i;
pic_value *args;
pic_value arg;
xh_entry **it;
pic_value arg_list;
pic_get_args(pic, "l*", &proc, &argc, &args);
it = pic_malloc(pic, argc * sizeof(xh_entry));
for (i = 0; i < argc; ++i) {
if (! pic_dict_p(args[i])) {
pic_free(pic, it);
pic_errorf(pic, "expected dict, but got %s", pic_type_repr(pic_type(args[i])));
}
it[i] = xh_begin(&pic_dict_ptr(args[i])->hash);
}
if (argc != 0) {
khiter_t it[argc];
khash_t(dict) *kh[argc];
for (i = 0; i < argc; ++i) {
if (! pic_dict_p(args[i])) {
pic_errorf(pic, "expected dict, but got %s", pic_type_repr(pic_type(args[i])));
}
kh[i] = &pic_dict_ptr(args[i])->hash;
it[i] = kh_begin(kh[i]);
}
pic_try {
do {
arg = pic_nil_value();
arg_list = pic_nil_value();
for (i = 0; i < argc; ++i) {
if (it[i] == NULL) {
while (it[i] != kh_end(kh[i])) { /* find next available */
if (kh_exist(kh[i], it[i]))
break;
it[i]++;
}
if (it[i] == kh_end(kh[i])) {
break;
}
pic_push(pic, pic_obj_value(xh_key(it[i], pic_sym *)), arg);
it[i] = xh_next(it[i]);
pic_push(pic, pic_obj_value(kh_key(kh[i], it[i]++)), arg_list);
}
if (i != argc) {
break;
}
pic_void(pic_apply(pic, proc, pic_reverse(pic, arg)));
pic_void(pic_apply(pic, proc, pic_reverse(pic, arg_list)));
} while (1);
}
pic_catch {
pic_free(pic, it);
pic_raise(pic, pic->err);
}
pic_free(pic, it);
return pic_undef_value();
}
@ -238,12 +246,13 @@ pic_dict_dictionary_to_alist(pic_state *pic)
{
struct pic_dict *dict;
pic_value item, alist = pic_nil_value();
xh_entry *it;
pic_sym *sym;
khiter_t it;
pic_get_args(pic, "d", &dict);
for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
item = pic_cons(pic, pic_obj_value(xh_key(it, pic_sym *)), xh_val(it, pic_value));
pic_dict_for_each (sym, dict, it) {
item = pic_cons(pic, pic_obj_value(sym), pic_dict_ref(pic, dict, sym));
pic_push(pic, item, alist);
}
@ -273,13 +282,14 @@ pic_dict_dictionary_to_plist(pic_state *pic)
{
struct pic_dict *dict;
pic_value plist = pic_nil_value();
xh_entry *it;
pic_sym *sym;
khiter_t it;
pic_get_args(pic, "d", &dict);
for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
pic_push(pic, pic_obj_value(xh_key(it, pic_sym *)), plist);
pic_push(pic, xh_val(it, pic_value), plist);
pic_dict_for_each (sym, dict, it) {
pic_push(pic, pic_obj_value(sym), plist);
pic_push(pic, pic_dict_ref(pic, dict, sym), plist);
}
return pic_reverse(pic, plist);

86
extlib/benz/gc.c
View File

@ -405,14 +405,17 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
}
case PIC_TT_ENV: {
struct pic_env *env = (struct pic_env *)obj;
xh_entry *it;
khash_t(env) *h = &env->map;
khiter_t it;
if (env->up) {
gc_mark_object(pic, (struct pic_object *)env->up);
}
for (it = xh_begin(&env->map); it != NULL; it = xh_next(it)) {
gc_mark_object(pic, xh_key(it, struct pic_object *));
gc_mark_object(pic, xh_val(it, struct pic_object *));
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (kh_exist(h, it)) {
gc_mark_object(pic, kh_key(h, it));
gc_mark_object(pic, (struct pic_object *)kh_val(h, it));
}
}
break;
}
@ -442,11 +445,8 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
}
case PIC_TT_DATA: {
struct pic_data *data = (struct pic_data *)obj;
xh_entry *it;
for (it = xh_begin(&data->storage); it != NULL; it = xh_next(it)) {
gc_mark(pic, xh_val(it, pic_value));
}
gc_mark_object(pic, (struct pic_object *)data->storage);
if (data->type->mark) {
data->type->mark(pic, data->data, gc_mark);
}
@ -454,11 +454,12 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
}
case PIC_TT_DICT: {
struct pic_dict *dict = (struct pic_dict *)obj;
xh_entry *it;
pic_sym *sym;
khiter_t it;
for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
gc_mark_object(pic, (struct pic_object *)xh_key(it, pic_sym *));
gc_mark(pic, xh_val(it, pic_value));
pic_dict_for_each (sym, dict, it) {
gc_mark_object(pic, (struct pic_object *)sym);
gc_mark(pic, pic_dict_ref(pic, dict, sym));
}
break;
}
@ -624,16 +625,20 @@ gc_mark_phase(pic_state *pic)
do {
struct pic_object *key;
pic_value val;
xh_entry *it;
khiter_t it;
khash_t(reg) *h;
struct pic_reg *reg;
j = 0;
reg = pic->regs;
while (reg != NULL) {
for (it = xh_begin(&reg->hash); it != NULL; it = xh_next(it)) {
key = xh_key(it, struct pic_object *);
val = xh_val(it, pic_value);
h = &reg->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
key = kh_key(h, it);
val = kh_val(h, it);
if (gc_obj_is_marked(key) && gc_value_need_mark(val)) {
gc_mark(pic, val);
++j;
@ -686,7 +691,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
}
case PIC_TT_ENV: {
struct pic_env *env = (struct pic_env *)obj;
xh_destroy(&env->map);
kh_destroy(env, &env->map);
break;
}
case PIC_TT_LIB: {
@ -705,12 +710,11 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
if (data->type->dtor) {
data->type->dtor(pic, data->data);
}
xh_destroy(&data->storage);
break;
}
case PIC_TT_DICT: {
struct pic_dict *dict = (struct pic_dict *)obj;
xh_destroy(&dict->hash);
kh_destroy(dict, &dict->hash);
break;
}
case PIC_TT_RECORD: {
@ -721,7 +725,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
}
case PIC_TT_REG: {
struct pic_reg *reg = (struct pic_reg *)obj;
xh_destroy(&reg->hash);
kh_destroy(reg, &reg->hash);
break;
}
case PIC_TT_CP: {
@ -744,26 +748,21 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
static void
gc_sweep_symbols(pic_state *pic)
{
xh_entry *it;
xvect_t(xh_entry *) xv;
size_t i;
char *cstr;
khash_t(s) *h = &pic->syms;
khiter_t it;
pic_sym *sym;
const char *cstr;
xv_init(xv);
for (it = xh_begin(&pic->syms); it != NULL; it = xh_next(it)) {
if (! gc_obj_is_marked((struct pic_object *)xh_val(it, pic_sym *))) {
xv_push(xh_entry *, xv, it);
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
sym = kh_val(h, it);
if (! gc_obj_is_marked((struct pic_object *)sym)) {
cstr = kh_key(h, it);
kh_del(s, h, it);
pic_free(pic, (void *)cstr);
}
}
for (i = 0; i < xv_size(xv); ++i) {
cstr = xh_key(xv_A(xv, i), char *);
xh_del_str(&pic->syms, cstr);
pic_free(pic, cstr);
}
}
static void
@ -821,14 +820,17 @@ static void
gc_sweep_phase(pic_state *pic)
{
struct heap_page *page = pic->heap->pages;
xh_entry *it, *next;
khiter_t it;
khash_t(reg) *h;
/* registries */
while (pic->regs != NULL) {
for (it = xh_begin(&pic->regs->hash); it != NULL; it = next) {
next = xh_next(it);
if (! gc_obj_is_marked(xh_key(it, struct pic_object *))) {
xh_del_ptr(&pic->regs->hash, xh_key(it, struct pic_object *));
h = &pic->regs->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
if (! gc_obj_is_marked(kh_key(h, it))) {
kh_del(reg, h, it);
}
}
pic->regs = pic->regs->prev;

8
extlib/benz/include/picrin.h
View File

@ -35,8 +35,8 @@ extern "C" {
#include "picrin/config.h"
#include "picrin/compat.h"
#include "picrin/xvect.h"
#include "picrin/xhash.h"
#include "picrin/kvec.h"
#include "picrin/khash.h"
#include "picrin/value.h"
@ -47,6 +47,8 @@ typedef struct pic_state pic_state;
#include "picrin/read.h"
#include "picrin/gc.h"
KHASH_DECLARE(s, const char *, pic_sym *);
typedef struct pic_checkpoint {
PIC_OBJECT_HEADER
struct pic_proc *in;
@ -124,7 +126,7 @@ struct pic_state {
pic_value features;
xhash syms; /* name to symbol */
khash_t(s) syms; /* name to symbol */
int ucnt;
struct pic_dict *globals;
struct pic_dict *macros;

2
extlib/benz/include/picrin/data.h
View File

@ -18,7 +18,7 @@ typedef struct {
struct pic_data {
PIC_OBJECT_HEADER
const pic_data_type *type;
xhash storage; /* const char * to pic_value table */
struct pic_dict *storage;
void *data;
};

12
extlib/benz/include/picrin/dict.h
View File

@ -9,9 +9,11 @@
extern "C" {
#endif
KHASH_DECLARE(dict, pic_sym *, pic_value)
struct pic_dict {
PIC_OBJECT_HEADER
xhash hash;
khash_t(dict) hash;
};
#define pic_dict_p(v) (pic_type(v) == PIC_TT_DICT)
@ -19,9 +21,11 @@ struct pic_dict {
struct pic_dict *pic_make_dict(pic_state *);
#define pic_dict_for_each(sym, dict, it) \
for (it = xh_begin(&(dict)->hash); it != NULL; it = xh_next(it)) \
if ((sym = xh_key(it, pic_sym *)), true)
#define pic_dict_for_each(sym, dict, it) \
pic_dict_for_each_help(sym, (&dict->hash), it)
#define pic_dict_for_each_help(sym, h, it) \
for (it = kh_begin(h); it != kh_end(h); ++it) \
if ((sym = kh_key(h, it)), kh_exist(h, it))
pic_value pic_dict_ref(pic_state *, struct pic_dict *, pic_sym *);
void pic_dict_set(pic_state *, struct pic_dict *, pic_sym *, pic_value);

263
extlib/benz/include/picrin/khash.h Normal file
View File

@ -0,0 +1,263 @@
/* The MIT License
Copyright (c) 2015 by Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Copyright (c) 2008, 2009, 2011 by Attractive Chaos <attractor@live.co.uk>
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
*/
#ifndef AC_KHASH_H
#define AC_KHASH_H
#include <limits.h>
#if UINT_MAX == 0xffffffffu
typedef unsigned int khint32_t;
#elif ULONG_MAX == 0xffffffffu
typedef unsigned long khint32_t;
#endif
#if ULONG_MAX == ULLONG_MAX
typedef unsigned long khint64_t;
#else
typedef unsigned long long khint64_t;
#endif
typedef khint32_t khint_t;
typedef khint_t khiter_t;
#define ac_isempty(flag, i) ((flag[i>>4]>>((i&0xfU)<<1))&2)
#define ac_isdel(flag, i) ((flag[i>>4]>>((i&0xfU)<<1))&1)
#define ac_iseither(flag, i) ((flag[i>>4]>>((i&0xfU)<<1))&3)
#define ac_set_isdel_false(flag, i) (flag[i>>4]&=~(1ul<<((i&0xfU)<<1)))
#define ac_set_isempty_false(flag, i) (flag[i>>4]&=~(2ul<<((i&0xfU)<<1)))
#define ac_set_isboth_false(flag, i) (flag[i>>4]&=~(3ul<<((i&0xfU)<<1)))
#define ac_set_isdel_true(flag, i) (flag[i>>4]|=1ul<<((i&0xfU)<<1))
#define ac_roundup32(x) \
(--(x), (x)|=(x)>>1, (x)|=(x)>>2, (x)|=(x)>>4, (x)|=(x)>>8, (x)|=(x)>>16, ++(x))
PIC_INLINE khint_t ac_X31_hash_string(const char *s)
{
khint_t h = (khint_t)*s;
if (h) for (++s ; *s; ++s) h = (h << 5) - h + (khint_t)*s;
return h;
}
PIC_INLINE khint_t ac_Wang_hash(khint_t key)
{
key += ~(key << 15);
key ^= (key >> 10);
key += (key << 3);
key ^= (key >> 6);
key += ~(key << 11);
key ^= (key >> 16);
return key;
}
#define ac_fsize(m) ((m) < 16? 1 : (m)>>4)
#define ac_hash_upper(x) ((((x) * 2) * 77 / 100 + 1) / 2)
#define KHASH_DECLARE(name, khkey_t, khval_t) \
typedef struct { \
khint_t n_buckets, size, n_occupied, upper_bound; \
khint32_t *flags; \
khkey_t *keys; \
khval_t *vals; \
} kh_##name##_t; \
void kh_init_##name(kh_##name##_t *h); \
void kh_destroy_##name(pic_state *, kh_##name##_t *h); \
void kh_clear_##name(kh_##name##_t *h); \
khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key); \
void kh_resize_##name(pic_state *, kh_##name##_t *h, khint_t new_n_buckets); \
khint_t kh_put_##name(pic_state *, kh_##name##_t *h, khkey_t key, int *ret); \
void kh_del_##name(kh_##name##_t *h, khint_t x);
#define KHASH_DEFINE(name, khkey_t, khval_t, hash_func, hash_equal) \
KHASH_DEFINE2(name, khkey_t, khval_t, 1, hash_func, hash_equal)
#define KHASH_DEFINE2(name, khkey_t, khval_t, kh_is_map, hash_func, hash_equal) \
void kh_init_##name(kh_##name##_t *h) { \
memset(h, 0, sizeof(kh_##name##_t)); \
} \
void kh_destroy_##name(pic_state *pic, kh_##name##_t *h) \
{ \
pic_free(pic, h->flags); \
pic_free(pic, (void *)h->keys); \
pic_free(pic, (void *)h->vals); \
} \
void kh_clear_##name(kh_##name##_t *h) \
{ \
if (h->flags) { \
memset(h->flags, 0xaa, ac_fsize(h->n_buckets) * sizeof(khint32_t)); \
h->size = h->n_occupied = 0; \
} \
} \
khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key) \
{ \
if (h->n_buckets) { \
khint_t k, i, last, mask, step = 0; \
mask = h->n_buckets - 1; \
k = hash_func(key); i = k & mask; \
last = i; \
while (!ac_isempty(h->flags, i) && (ac_isdel(h->flags, i) || !hash_equal(h->keys[i], key))) { \
i = (i + (++step)) & mask; \
if (i == last) return h->n_buckets; \
} \
return ac_iseither(h->flags, i)? h->n_buckets : i; \
} else return 0; \
} \
void kh_resize_##name(pic_state *pic, kh_##name##_t *h, khint_t new_n_buckets) \
{ /* This function uses 0.25*n_buckets bytes of working space instead of [sizeof(key_t+val_t)+.25]*n_buckets. */ \
khint32_t *new_flags = 0; \
khint_t j = 1; \
{ \
ac_roundup32(new_n_buckets); \
if (new_n_buckets < 4) new_n_buckets = 4; \
if (h->size >= ac_hash_upper(new_n_buckets)) j = 0; /* requested size is too small */ \
else { /* hash table size to be changed (shrink or expand); rehash */ \
new_flags = pic_malloc(pic, ac_fsize(new_n_buckets) * sizeof(khint32_t)); \
memset(new_flags, 0xaa, ac_fsize(new_n_buckets) * sizeof(khint32_t)); \
if (h->n_buckets < new_n_buckets) { /* expand */ \
h->keys = pic_realloc(pic, (void *)h->keys, new_n_buckets * sizeof(khkey_t)); \
if (kh_is_map) { \
h->vals = pic_realloc(pic, (void *)h->vals, new_n_buckets * sizeof(khval_t)); \
} \
} /* otherwise shrink */ \
} \
} \
if (j) { /* rehashing is needed */ \
for (j = 0; j != h->n_buckets; ++j) { \
if (ac_iseither(h->flags, j) == 0) { \
khkey_t key = h->keys[j]; \
khval_t val; \
khint_t new_mask; \
new_mask = new_n_buckets - 1; \
if (kh_is_map) val = h->vals[j]; \
ac_set_isdel_true(h->flags, j); \
while (1) { /* kick-out process; sort of like in Cuckoo hashing */ \
khint_t k, i, step = 0; \
k = hash_func(key); \
i = k & new_mask; \
while (!ac_isempty(new_flags, i)) i = (i + (++step)) & new_mask; \
ac_set_isempty_false(new_flags, i); \
if (i < h->n_buckets && ac_iseither(h->flags, i) == 0) { /* kick out the existing element */ \
{ khkey_t tmp = h->keys[i]; h->keys[i] = key; key = tmp; } \
if (kh_is_map) { khval_t tmp = h->vals[i]; h->vals[i] = val; val = tmp; } \
ac_set_isdel_true(h->flags, i); /* mark it as deleted in the old hash table */ \
} else { /* write the element and jump out of the loop */ \
h->keys[i] = key; \
if (kh_is_map) h->vals[i] = val; \
break; \
} \
} \
} \
} \
if (h->n_buckets > new_n_buckets) { /* shrink the hash table */ \
h->keys = pic_realloc(pic, (void *)h->keys, new_n_buckets * sizeof(khkey_t)); \
if (kh_is_map) h->vals = pic_realloc(pic, (void *)h->vals, new_n_buckets * sizeof(khval_t)); \
} \
pic_free(pic, h->flags); /* free the working space */ \
h->flags = new_flags; \
h->n_buckets = new_n_buckets; \
h->n_occupied = h->size; \
h->upper_bound = ac_hash_upper(h->n_buckets); \
} \
} \
khint_t kh_put_##name(pic_state *pic, kh_##name##_t *h, khkey_t key, int *ret) \
{ \
khint_t x; \
if (h->n_occupied >= h->upper_bound) { /* update the hash table */ \
if (h->n_buckets > (h->size<<1)) { \
kh_resize_##name(pic, h, h->n_buckets - 1); /* clear "deleted" elements */ \
} else { \
kh_resize_##name(pic, h, h->n_buckets + 1); /* expand the hash table */ \
} \
} /* TODO: to implement automatically shrinking; resize() already support shrinking */ \
{ \
khint_t k, i, site, last, mask = h->n_buckets - 1, step = 0; \
x = site = h->n_buckets; k = hash_func(key); i = k & mask; \
if (ac_isempty(h->flags, i)) x = i; /* for speed up */ \
else { \
last = i; \
while (!ac_isempty(h->flags, i) && (ac_isdel(h->flags, i) || !hash_equal(h->keys[i], key))) { \
if (ac_isdel(h->flags, i)) site = i; \
i = (i + (++step)) & mask; \
if (i == last) { x = site; break; } \
} \
if (x == h->n_buckets) { \
if (ac_isempty(h->flags, i) && site != h->n_buckets) x = site; \
else x = i; \
} \
} \
} \
if (ac_isempty(h->flags, x)) { /* not present at all */ \
h->keys[x] = key; \
ac_set_isboth_false(h->flags, x); \
++h->size; ++h->n_occupied; \
*ret = 1; \
} else if (ac_isdel(h->flags, x)) { /* deleted */ \
h->keys[x] = key; \
ac_set_isboth_false(h->flags, x); \
++h->size; \
*ret = 2; \
} else *ret = 0; /* Don't touch h->keys[x] if present and not deleted */ \
return x; \
} \
void kh_del_##name(kh_##name##_t *h, khint_t x) \
{ \
if (x != h->n_buckets && !ac_iseither(h->flags, x)) { \
ac_set_isdel_true(h->flags, x); \
--h->size; \
} \
}
/* --- BEGIN OF HASH FUNCTIONS --- */
#define kh_ptr_hash_func(key) (khint32_t)(long)(key)
#define kh_ptr_hash_equal(a, b) ((a) == (b))
#define kh_int_hash_func(key) (khint32_t)(key)
#define kh_int_hash_equal(a, b) ((a) == (b))
#define kh_int64_hash_func(key) (khint32_t)((key)>>33^(key)^(key)<<11)
#define kh_int64_hash_equal(a, b) ((a) == (b))
#define kh_str_hash_func(key) ac_X31_hash_string(key)
#define kh_str_hash_equal(a, b) (strcmp(a, b) == 0)
#define kh_int_hash_func2(k) ac_Wang_hash((khint_t)key)
/* --- END OF HASH FUNCTIONS --- */
#define khash_t(name) kh_##name##_t
#define kh_init(name, h) kh_init_##name(h)
#define kh_destroy(name, h) kh_destroy_##name(pic, h)
#define kh_clear(name, h) kh_clear_##name(h)
#define kh_resize(name, h, s) kh_resize_##name(pic, h, s)
#define kh_put(name, h, k, r) kh_put_##name(pic, h, k, r)
#define kh_get(name, h, k) kh_get_##name(h, k)
#define kh_del(name, h, k) kh_del_##name(h, k)
#define kh_exist(h, x) (!ac_iseither((h)->flags, (x)))
#define kh_key(h, x) ((h)->keys[x])
#define kh_val(h, x) ((h)->vals[x])
#define kh_value(h, x) ((h)->vals[x])
#define kh_begin(h) (khint_t)(0)
#define kh_end(h) ((h)->n_buckets)
#define kh_size(h) ((h)->size)
#define kh_n_buckets(h) ((h)->n_buckets)
#endif /* AC_KHASH_H */

67
extlib/benz/include/picrin/kvec.h Normal file
View File

@ -0,0 +1,67 @@
/* The MIT License
Copyright (c) 2015, by Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Copyright (c) 2008, by Attractive Chaos <attractor@live.co.uk>
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
*/
#ifndef AC_KVEC_H
#define AC_KVEC_H
#define kv_roundup32(x) (--(x), (x)|=(x)>>1, (x)|=(x)>>2, (x)|=(x)>>4, (x)|=(x)>>8, (x)|=(x)>>16, ++(x))
#define kvec_t(type) struct { size_t n, m; type *a; }
#define kv_init(v) ((v).n = (v).m = 0, (v).a = 0)
#define kv_destroy(v) pic_free((pic), (v).a)
#define kv_A(v, i) ((v).a[(i)])
#define kv_pop(v) ((v).a[--(v).n])
#define kv_size(v) ((v).n)
#define kv_max(v) ((v).m)
#define kv_resize(type, v, s) ((v).m = (s), (v).a = (type*)pic_realloc((pic), (v).a, sizeof(type) * (v).m))
#define kv_copy(type, v1, v0) do { \
if ((v1).m < (v0).n) kv_resize((pic), type, v1, (v0).n); \
(v1).n = (v0).n; \
memcpy((v1).a, (v0).a, sizeof(type) * (v0).n); \
} while (0) \
#define kv_push(type, v, x) do { \
if ((v).n == (v).m) { \
(v).m = (v).m? (v).m<<1 : 2; \
(v).a = (type*)pic_realloc((pic), (v).a, sizeof(type) * (v).m); \
} \
(v).a[(v).n++] = (x); \
} while (0)
#define kv_pushp(type, v) \
(((v).n == (v).m)? \
((v).m = ((v).m? (v).m<<1 : 2), \
(v).a = (type*)pic_realloc((pic), (v).a, sizeof(type) * (v).m), 0) \
: 0), ((v).a + ((v).n++))
#define kv_a(type, v, i) \
(((v).m <= (size_t)(i)? \
((v).m = (v).n = (i) + 1, kv_roundup32((v).m), \
(v).a = (type*)pic_realloc((pic), (v).a, sizeof(type) * (v).m), 0) \
: (v).n <= (size_t)(i)? (v).n = (i) + 1 \
: 0), (v).a[(i)])
#endif

4
extlib/benz/include/picrin/macro.h
View File

@ -9,6 +9,8 @@
extern "C" {
#endif
KHASH_DECLARE(env, void *, pic_sym *)
struct pic_id {
PIC_OBJECT_HEADER
pic_value var;
@ -17,7 +19,7 @@ struct pic_id {
struct pic_env {
PIC_OBJECT_HEADER
xhash map;
khash_t(env) map;
struct pic_env *up;
};

4
extlib/benz/include/picrin/read.h
View File

@ -9,6 +9,8 @@
extern "C" {
#endif
KHASH_DECLARE(read, int, pic_value)
typedef pic_value (*pic_reader_t)(pic_state *, struct pic_port *port, int c);
typedef struct {
@ -16,7 +18,7 @@ typedef struct {
PIC_CASE_DEFAULT,
PIC_CASE_FOLD
} typecase;
xhash labels;
khash_t(read) labels;
pic_reader_t table[256];
pic_reader_t dispatch[256];
} pic_reader;

4
extlib/benz/include/picrin/reg.h
View File

@ -9,9 +9,11 @@
extern "C" {
#endif
KHASH_DECLARE(reg, void *, pic_value)
struct pic_reg {
PIC_OBJECT_HEADER
xhash hash;
khash_t(reg) hash;
struct pic_reg *prev; /* for GC */
};

416
extlib/benz/include/picrin/xhash.h
View File

@ -1,416 +0,0 @@
#ifndef XHASH_H
#define XHASH_H
/*
* Copyright (c) 2013-2014 by Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
*/
#if defined(__cplusplus)
extern "C" {
#endif
#define XHASH_ALLOCATOR pic->allocf
/* simple object to object hash table */
#define XHASH_INIT_SIZE 11
#define XHASH_RESIZE_RATIO(x) ((x) * 3 / 4)
#define XHASH_ALIGNMENT 3 /* quad word alignment */
#define XHASH_MASK (~(size_t)((1 << XHASH_ALIGNMENT) - 1))
#define XHASH_ALIGN(i) ((((i) - 1) & XHASH_MASK) + (1 << XHASH_ALIGNMENT))
typedef struct xh_entry {
struct xh_entry *next;
int hash;
struct xh_entry *fw, *bw;
const void *key;
void *val;
} xh_entry;
#define xh_key(e,type) (*(type *)((e)->key))
#define xh_val(e,type) (*(type *)((e)->val))
typedef int (*xh_hashf)(const void *, void *);
typedef int (*xh_equalf)(const void *, const void *, void *);
typedef void *(*xh_allocf)(void *, size_t);
typedef struct xhash {
xh_allocf allocf;
xh_entry **buckets;
size_t size, count, kwidth, vwidth;
size_t koffset, voffset;
xh_hashf hashf;
xh_equalf equalf;
xh_entry *head, *tail;
void *data;
} xhash;
/** Protected Methods:
* static inline void xh_init_(xhash *x, size_t, size_t, xh_hashf, xh_equalf, void *);
* static inline xh_entry *xh_get_(xhash *x, const void *key);
* static inline xh_entry *xh_put_(xhash *x, const void *key, void *val);
* static inline void xh_del_(xhash *x, const void *key);
*/
/* string map */
PIC_INLINE xh_entry *xh_get_str(xhash *x, const char *key);
PIC_INLINE xh_entry *xh_put_str(xhash *x, const char *key, void *);
PIC_INLINE void xh_del_str(xhash *x, const char *key);
/* object map */
PIC_INLINE xh_entry *xh_get_ptr(xhash *x, const void *key);
PIC_INLINE xh_entry *xh_put_ptr(xhash *x, const void *key, void *);
PIC_INLINE void xh_del_ptr(xhash *x, const void *key);
/* int map */
PIC_INLINE xh_entry *xh_get_int(xhash *x, int key);
PIC_INLINE xh_entry *xh_put_int(xhash *x, int key, void *);
PIC_INLINE void xh_del_int(xhash *x, int key);
PIC_INLINE size_t xh_size(xhash *x);
PIC_INLINE void xh_clear(xhash *x);
PIC_INLINE void xh_destroy(xhash *x);
PIC_INLINE xh_entry *xh_begin(xhash *x);
PIC_INLINE xh_entry *xh_next(xh_entry *e);
PIC_INLINE void
xh_bucket_alloc(xhash *x, size_t newsize)
{
x->size = newsize;
x->buckets = x->allocf(NULL, (x->size + 1) * sizeof(xh_entry *));
memset(x->buckets, 0, (x->size + 1) * sizeof(xh_entry *));
}
PIC_INLINE void
xh_init_(xhash *x, xh_allocf allocf, size_t kwidth, size_t vwidth, xh_hashf hashf, xh_equalf equalf, void *data)
{
x->allocf = allocf;
x->size = 0;
x->buckets = NULL;
x->count = 0;
x->kwidth = kwidth;
x->vwidth = vwidth;
x->koffset = XHASH_ALIGN(sizeof(xh_entry));
x->voffset = XHASH_ALIGN(sizeof(xh_entry)) + XHASH_ALIGN(kwidth);
x->hashf = hashf;
x->equalf = equalf;
x->head = NULL;
x->tail = NULL;
x->data = data;
xh_bucket_alloc(x, XHASH_INIT_SIZE);
}
PIC_INLINE xh_entry *
xh_get_(xhash *x, const void *key)
{
int hash;
size_t idx;
xh_entry *e;
hash = x->hashf(key, x->data);
idx = ((unsigned)hash) % x->size;
for (e = x->buckets[idx]; e; e = e->next) {
if (e->hash == hash && x->equalf(key, e->key, x->data))
break;
}
return e;
}
PIC_INLINE void
xh_resize_(xhash *x, size_t newsize)
{
xhash y;
xh_entry *it;
size_t idx;
xh_init_(&y, x->allocf, x->kwidth, x->vwidth, x->hashf, x->equalf, x->data);
xh_bucket_alloc(&y, newsize);
for (it = xh_begin(x); it != NULL; it = xh_next(it)) {
idx = ((unsigned)it->hash) % y.size;
/* reuse entry object */
it->next = y.buckets[idx];
y.buckets[idx] = it;
y.count++;
}
y.head = x->head;
y.tail = x->tail;
x->allocf(x->buckets, 0);
/* copy all members from y to x */
memcpy(x, &y, sizeof(xhash));
}
PIC_INLINE xh_entry *
xh_put_(xhash *x, const void *key, void *val)
{
int hash;
size_t idx;
xh_entry *e;
if ((e = xh_get_(x, key))) {
memcpy(e->val, val, x->vwidth);
return e;
}
if (x->count + 1 > XHASH_RESIZE_RATIO(x->size)) {
xh_resize_(x, x->size * 2 + 1);
}
hash = x->hashf(key, x->data);
idx = ((unsigned)hash) % x->size;
e = x->allocf(NULL, x->voffset + x->vwidth);
e->next = x->buckets[idx];
e->hash = hash;
e->key = ((char *)e) + x->koffset;
e->val = ((char *)e) + x->voffset;
memcpy((void *)e->key, key, x->kwidth);
memcpy(e->val, val, x->vwidth);
if (x->head == NULL) {
x->head = x->tail = e;
e->fw = e->bw = NULL;
} else {
x->tail->bw = e;
e->fw = x->tail;
e->bw = NULL;
x->tail = e;
}
x->count++;
return x->buckets[idx] = e;
}
PIC_INLINE void
xh_del_(xhash *x, const void *key)
{
int hash;
size_t idx;
xh_entry *p, *q, *r;
hash = x->hashf(key, x->data);
idx = ((unsigned)hash) % x->size;
if (x->buckets[idx]->hash == hash && x->equalf(key, x->buckets[idx]->key, x->data)) {
q = x->buckets[idx];
if (q->fw == NULL) {
x->head = q->bw;
} else {
q->fw->bw = q->bw;
}
if (q->bw == NULL) {
x->tail = q->fw;
} else {
q->bw->fw = q->fw;
}
r = q->next;
x->allocf(q, 0);
x->buckets[idx] = r;
}
else {
for (p = x->buckets[idx]; ; p = p->next) {
if (p->next->hash == hash && x->equalf(key, p->next->key, x->data))
break;
}
q = p->next;
if (q->fw == NULL) {
x->head = q->bw;
} else {
q->fw->bw = q->bw;
}
if (q->bw == NULL) {
x->tail = q->fw;
} else {
q->bw->fw = q->fw;
}
r = q->next;
x->allocf(q, 0);
p->next = r;
}
x->count--;
}
PIC_INLINE size_t
xh_size(xhash *x)
{
return x->count;
}
PIC_INLINE void
xh_clear(xhash *x)
{
size_t i;
xh_entry *e, *d;
for (i = 0; i < x->size; ++i) {
e = x->buckets[i];
while (e) {
d = e->next;
x->allocf(e, 0);
e = d;
}
x->buckets[i] = NULL;
}
x->head = x->tail = NULL;
x->count = 0;
}
PIC_INLINE void
xh_destroy(xhash *x)
{
xh_clear(x);
x->allocf(x->buckets, 0);
}
/* string map */
PIC_INLINE int
xh_str_hash(const void *key, void *data)
{
const char *str = *(const char **)key;
int hash = 0;
(void)data;
while (*str) {
hash = hash * 31 + *str++;
}
return hash;
}
PIC_INLINE int
xh_str_equal(const void *key1, const void *key2, void *data)
{
const char *s1 = *(const char **)key1, *s2 = *(const char **)key2;
(void)data;
return strcmp(s1, s2) == 0;
}
#define xh_init_str(x, width) \
xh_init_(x, XHASH_ALLOCATOR, sizeof(const char *), width, xh_str_hash, xh_str_equal, NULL);
PIC_INLINE xh_entry *
xh_get_str(xhash *x, const char *key)
{
return xh_get_(x, &key);
}
PIC_INLINE xh_entry *
xh_put_str(xhash *x, const char *key, void *val)
{
return xh_put_(x, &key, val);
}
PIC_INLINE void
xh_del_str(xhash *x, const char *key)
{
xh_del_(x, &key);
}
/* object map */
PIC_INLINE int
xh_ptr_hash(const void *key, void *data)
{
(void)data;
return (int)(size_t)*(const void **)key;
}
PIC_INLINE int
xh_ptr_equal(const void *key1, const void *key2, void *data)
{
(void) data;
return *(const void **)key1 == *(const void **)key2;
}
#define xh_init_ptr(x, width) \
xh_init_(x, XHASH_ALLOCATOR, sizeof(const void *), width, xh_ptr_hash, xh_ptr_equal, NULL);
PIC_INLINE xh_entry *
xh_get_ptr(xhash *x, const void *key)
{
return xh_get_(x, &key);
}
PIC_INLINE xh_entry *
xh_put_ptr(xhash *x, const void *key, void *val)
{
return xh_put_(x, &key, val);
}
PIC_INLINE void
xh_del_ptr(xhash *x, const void *key)
{
xh_del_(x, &key);
}
/* int map */
PIC_INLINE int
xh_int_hash(const void *key, void *data)
{
(void)data;
return *(int *)key;
}
PIC_INLINE int
xh_int_equal(const void *key1, const void *key2, void *data)
{
(void)data;
return *(int *)key1 == *(int *)key2;
}
#define xh_init_int(x, width) \
xh_init_(x, XHASH_ALLOCATOR, sizeof(int), width, xh_int_hash, xh_int_equal, NULL);
PIC_INLINE xh_entry *
xh_get_int(xhash *x, int key)
{
return xh_get_(x, &key);
}
PIC_INLINE xh_entry *
xh_put_int(xhash *x, int key, void *val)
{
return xh_put_(x, &key, val);
}
PIC_INLINE void
xh_del_int(xhash *x, int key)
{
xh_del_(x, &key);
}
/** iteration */
PIC_INLINE xh_entry *
xh_begin(xhash *x)
{
return x->head;
}
PIC_INLINE xh_entry *
xh_next(xh_entry *e)
{
return e->bw;
}
#if defined(__cplusplus)
}
#endif
#endif

76
extlib/benz/include/picrin/xvect.h
View File

@ -1,76 +0,0 @@
#ifndef XVECT_H__
#define XVECT_H__
/* The MIT License
Copyright (c) 2008, by Attractive Chaos <attractor@live.co.uk>
Copyright (c) 2014, by Yuichi Nishiwaki <yuichi@idylls.jp>
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
*/
#define xv_realloc(P,Z) pic_realloc(pic,P,Z)
#define xv_free(P) pic_free(pic,P)
#define xv_roundup32(x) \
(--(x), (x)|=(x)>>1, (x)|=(x)>>2, (x)|=(x)>>4, (x)|=(x)>>8, (x)|=(x)>>16, ++(x))
#define xvect_t(type) struct { size_t n, m; type *a; }
#define xv_init(v) ((v).n = (v).m = 0, (v).a = 0)
#define xv_destroy(v) xv_free((v).a)
#define xv_A(v, i) ((v).a[(i)])
#define xv_pop(v) ((v).a[--(v).n])
#define xv_size(v) ((v).n)
#define xv_max(v) ((v).m)
#define xv_resize(type, v, s) \
((v).m = (s), (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m))
#define xv_copy(type, v1, v0) \
do { \
if ((v1).m < (v0).n) xv_resize(type, v1, (v0).n); \
(v1).n = (v0).n; \
memcpy((v1).a, (v0).a, sizeof(type) * (v0).n); \
} while (0) \
#define xv_push(type, v, x) \
do { \
if ((v).n == (v).m) { \
(v).m = (v).m? (v).m<<1 : (size_t)2; \
(v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m); \
} \
(v).a[(v).n++] = (x); \
} while (0)
#define xv_pushp(type, v) \
(((v).n == (v).m)? \
((v).m = ((v).m? (v).m<<1 : (size_t)2), \
(v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m), 0) \
: 0), ((v).a + ((v).n++))
#define xv_a(type, v, i) \
(((v).m <= (size_t)(i)? \
((v).m = (v).n = (i) + 1, xv_roundup32((v).m), \
(v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m), 0) \
: (v).n <= (size_t)(i)? (v).n = (i) + 1 \
: (size_t)0), (v).a[(i)])
#endif

4
extlib/benz/lib.c
View File

@ -58,7 +58,7 @@ void
pic_import(pic_state *pic, struct pic_lib *lib)
{
pic_sym *name, *realname, *uid;
xh_entry *it;
khiter_t it;
pic_dict_for_each (name, lib->exports, it) {
realname = pic_sym_ptr(pic_dict_ref(pic, lib->exports, name));
@ -173,7 +173,7 @@ pic_lib_library_exports(pic_state *pic)
{
pic_value lib, exports = pic_nil_value();
pic_sym *sym;
xh_entry *it;
khiter_t it;
pic_get_args(pic, "o", &lib);

17
extlib/benz/macro.c
View File

@ -4,6 +4,8 @@
#include "picrin.h"
KHASH_DEFINE(env, void *, pic_sym *, kh_ptr_hash_func, kh_ptr_hash_equal)
bool
pic_var_p(pic_value obj)
{
@ -30,7 +32,7 @@ pic_make_env(pic_state *pic, struct pic_env *up)
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
env->up = up;
xh_init_ptr(&env->map, sizeof(pic_sym *));
kh_init(env, &env->map);
return env;
}
@ -74,22 +76,27 @@ pic_add_variable(pic_state *pic, struct pic_env *env, pic_value var)
void
pic_put_variable(pic_state PIC_UNUSED(*pic), struct pic_env *env, pic_value var, pic_sym *uid)
{
khiter_t it;
int ret;
assert(pic_var_p(var));
xh_put_ptr(&env->map, pic_ptr(var), &uid);
it = kh_put(env, &env->map, pic_ptr(var), &ret);
kh_val(&env->map, it) = uid;
}
pic_sym *
pic_find_variable(pic_state PIC_UNUSED(*pic), struct pic_env *env, pic_value var)
{
xh_entry *e;
khiter_t it;
assert(pic_var_p(var));
if ((e = xh_get_ptr(&env->map, pic_ptr(var))) == NULL) {
it = kh_get(env, &env->map, pic_ptr(var));
if (it == kh_end(&env->map)) {
return NULL;
}
return xh_val(e, pic_sym *);
return kh_val(&env->map, it);
}
static pic_value

33
extlib/benz/read.c
View File

@ -4,6 +4,8 @@
#include "picrin.h"
KHASH_DEFINE(read, int, pic_value, kh_int_hash_func, kh_int_hash_equal)
static pic_value read(pic_state *pic, struct pic_port *port, int c);
static pic_value read_nullable(pic_state *pic, struct pic_port *port, int c);
@ -639,17 +641,19 @@ read_vector(pic_state *pic, struct pic_port *port, int c)
static pic_value
read_label_set(pic_state *pic, struct pic_port *port, int i)
{
khash_t(read) *h = &pic->reader.labels;
pic_value val;
int c;
int c, ret;
khiter_t it;
it = kh_put(read, h, i, &ret);
switch ((c = skip(pic, port, ' '))) {
case '(':
{
pic_value tmp;
val = pic_cons(pic, pic_undef_value(), pic_undef_value());
xh_put_int(&pic->reader.labels, i, &val);
kh_val(h, it) = val = pic_cons(pic, pic_undef_value(), pic_undef_value());
tmp = read(pic, port, c);
pic_pair_ptr(val)->car = pic_car(pic, tmp);
@ -670,9 +674,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
if (vect) {
pic_vec *tmp;
val = pic_obj_value(pic_make_vec(pic, 0));
xh_put_int(&pic->reader.labels, i, &val);
kh_val(h, it) = val = pic_obj_value(pic_make_vec(pic, 0));
tmp = pic_vec_ptr(read(pic, port, c));
PIC_SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data);
@ -685,9 +687,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
}
default:
{
val = read(pic, port, c);
xh_put_int(&pic->reader.labels, i, &val);
kh_val(h, it) = val = read(pic, port, c);
return val;
}
@ -697,13 +697,14 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
static pic_value
read_label_ref(pic_state *pic, struct pic_port PIC_UNUSED(*port), int i)
{
xh_entry *e;
khash_t(read) *h = &pic->reader.labels;
khiter_t it;
e = xh_get_int(&pic->reader.labels, i);
if (! e) {
it = kh_get(read, h, i);
if (it == kh_end(h)) {
read_error(pic, "label of given index not defined");
}
return xh_val(e, pic_value);
return kh_val(h, it);
}
static pic_value
@ -832,7 +833,7 @@ pic_reader_init(pic_state *pic)
int c;
pic->reader.typecase = PIC_CASE_DEFAULT;
xh_init_int(&pic->reader.labels, sizeof(pic_value));
kh_init(read, &pic->reader.labels);
for (c = 0; c < 256; ++c) {
pic->reader.table[c] = NULL;
@ -848,7 +849,7 @@ pic_reader_init(pic_state *pic)
void
pic_reader_destroy(pic_state *pic)
{
xh_destroy(&pic->reader.labels);
kh_destroy(read, &pic->reader.labels);
}
pic_value

31
extlib/benz/reg.c
View File

@ -4,6 +4,8 @@
#include "picrin.h"
KHASH_DEFINE(reg, void *, pic_value, kh_ptr_hash_func, kh_ptr_hash_equal)
struct pic_reg *
pic_make_reg(pic_state *pic)
{
@ -11,7 +13,7 @@ pic_make_reg(pic_state *pic)
reg = (struct pic_reg *)pic_obj_alloc(pic, sizeof(struct pic_reg), PIC_TT_REG);
reg->prev = NULL;
xh_init_ptr(&reg->hash, sizeof(pic_value));
kh_init(reg, &reg->hash);
return reg;
}
@ -19,35 +21,44 @@ pic_make_reg(pic_state *pic)
pic_value
pic_reg_ref(pic_state *pic, struct pic_reg *reg, void *key)
{
xh_entry *e;
khash_t(reg) *h = &reg->hash;
khiter_t it;
e = xh_get_ptr(&reg->hash, key);
if (! e) {
it = kh_get(reg, h, key);
if (it == kh_end(h)) {
pic_errorf(pic, "element not found for a key: ~s", pic_obj_value(key));
}
return xh_val(e, pic_value);
return kh_val(h, it);
}
void
pic_reg_set(pic_state PIC_UNUSED(*pic), struct pic_reg *reg, void *key, pic_value val)
{
xh_put_ptr(&reg->hash, key, &val);
khash_t(reg) *h = &reg->hash;
int ret;
khiter_t it;
it = kh_put(reg, h, key, &ret);
kh_val(h, it) = val;
}
bool
pic_reg_has(pic_state PIC_UNUSED(*pic), struct pic_reg *reg, void *key)
{
return xh_get_ptr(&reg->hash, key) != NULL;
return kh_get(reg, &reg->hash, key) != kh_end(&reg->hash);
}
void
pic_reg_del(pic_state *pic, struct pic_reg *reg, void *key)
{
if (xh_get_ptr(&reg->hash, key) == NULL) {
khash_t(reg) *h = &reg->hash;
khiter_t it;
it = kh_get(reg, h, key);
if (it == kh_end(h)) {
pic_errorf(pic, "no slot named ~s found in register", pic_obj_value(key));
}
xh_del_ptr(&reg->hash, key);
kh_del(reg, h, it);
}

17
extlib/benz/state.c
View File

@ -224,7 +224,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
pic->regs = NULL;
/* symbol table */
xh_init_str(&pic->syms, sizeof(pic_sym *));
kh_init(s, &pic->syms);
/* unique symbol count */
pic->ucnt = 0;
@ -399,13 +399,17 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
void
pic_close(pic_state *pic)
{
xh_entry *it;
khash_t(s) *h = &pic->syms;
khiter_t it;
pic_allocf allocf = pic->allocf;
/* free symbol names */
for (it = xh_begin(&pic->syms); it != NULL; it = xh_next(it)) {
allocf(xh_key(it, char *), 0);
/* free all symbols */
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (kh_exist(h, it)) {
allocf((void *)kh_key(h, it), 0);
}
}
kh_clear(s, h);
/* clear out root objects */
pic->sp = pic->stbase;
@ -416,7 +420,6 @@ pic_close(pic_state *pic)
pic->globals = NULL;
pic->macros = NULL;
pic->attrs = NULL;
xh_clear(&pic->syms);
pic->features = pic_nil_value();
pic->libs = pic_nil_value();
@ -438,7 +441,7 @@ pic_close(pic_state *pic)
allocf(pic->xpbase, 0);
/* free global stacks */
xh_destroy(&pic->syms);
kh_destroy(s, h);
/* free GC arena */
allocf(pic->arena, 0);

16
extlib/benz/symbol.c
View File

@ -4,6 +4,8 @@
#include "picrin.h"
KHASH_DEFINE(s, const char *, pic_sym *, kh_str_hash_func, kh_str_hash_equal)
static pic_sym *
pic_make_symbol(pic_state *pic, pic_str *str)
{
@ -17,22 +19,26 @@ pic_make_symbol(pic_state *pic, pic_str *str)
pic_sym *
pic_intern(pic_state *pic, pic_str *str)
{
xh_entry *e;
khash_t(s) *h = &pic->syms;
pic_sym *sym;
char *cstr;
khiter_t it;
int ret;
e = xh_get_str(&pic->syms, pic_str_cstr(pic, str));
if (e) {
sym = xh_val(e, pic_sym *);
it = kh_put(s, h, pic_str_cstr(pic, str), &ret);
if (ret == 0) { /* if exists */
sym = kh_val(h, it);
pic_gc_protect(pic, pic_obj_value(sym));
return sym;
}
cstr = pic_malloc(pic, pic_str_len(str) + 1);
strcpy(cstr, pic_str_cstr(pic, str));
kh_key(h, it) = cstr;
sym = pic_make_symbol(pic, str);
xh_put_str(&pic->syms, cstr, &sym);
kh_val(h, it) = sym;
return sym;
}

83
extlib/benz/write.c
View File

@ -36,12 +36,17 @@ is_quasiquote(pic_state *pic, pic_value pair)
return is_tagged(pic, pic->sQUASIQUOTE, pair);
}
KHASH_DECLARE(l, void *, int)
KHASH_DECLARE(v, void *, int)
KHASH_DEFINE2(l, void *, int, 1, kh_ptr_hash_func, kh_ptr_hash_equal)
KHASH_DEFINE2(v, void *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal)
struct writer_control {
pic_state *pic;
xFILE *file;
int mode;
xhash labels; /* object -> int */
xhash visited; /* object -> int */
khash_t(l) labels; /* object -> int */
khash_t(v) visited; /* object -> int */
int cnt;
};
@ -55,35 +60,36 @@ writer_control_init(struct writer_control *p, pic_state *pic, xFILE *file, int m
p->file = file;
p->mode = mode;
p->cnt = 0;
xh_init_ptr(&p->labels, sizeof(int));
xh_init_ptr(&p->visited, sizeof(int));
kh_init(l, &p->labels);
kh_init(v, &p->visited);
}
static void
writer_control_destroy(struct writer_control *p)
{
xh_destroy(&p->labels);
xh_destroy(&p->visited);
pic_state *pic = p->pic;
kh_destroy(l, &p->labels);
kh_destroy(v, &p->visited);
}
static void
traverse_shared(struct writer_control *p, pic_value obj)
{
xh_entry *e;
pic_state *pic = p->pic;
khash_t(l) *h = &p->labels;
khiter_t it;
size_t i;
int c;
int ret;
switch (pic_type(obj)) {
case PIC_TT_PAIR:
case PIC_TT_VECTOR:
e = xh_get_ptr(&p->labels, pic_obj_ptr(obj));
if (e == NULL) {
c = -1;
xh_put_ptr(&p->labels, pic_obj_ptr(obj), &c);
it = kh_put(l, h, pic_obj_ptr(obj), &ret);
if (ret != 0) {
kh_val(h, it) = -1;
}
else if (xh_val(e, int) == -1) {
c = p->cnt++;
xh_put_ptr(&p->labels, pic_obj_ptr(obj), &c);
else if (kh_val(h, it) == -1) {
kh_val(h, it) = p->cnt++;
break;
}
else {
@ -112,8 +118,10 @@ static void
write_pair(struct writer_control *p, struct pic_pair *pair)
{
pic_state *pic = p->pic;
xh_entry *e;
int c;
khash_t(l) *lh = &p->labels;
khash_t(v) *vh = &p->visited;
khiter_t it;
int ret;
write_core(p, pair->car);
@ -123,18 +131,15 @@ write_pair(struct writer_control *p, struct pic_pair *pair)
else if (pic_pair_p(pair->cdr)) {
/* shared objects */
if ((e = xh_get_ptr(&p->labels, pic_obj_ptr(pair->cdr))) && xh_val(e, int) != -1) {
if ((it = kh_get(l, lh, pic_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) {
xfprintf(pic, p->file, " . ");
if ((xh_get_ptr(&p->visited, pic_obj_ptr(pair->cdr)))) {
xfprintf(pic, p->file, "#%d#", xh_val(e, int));
kh_put(v, vh, pic_ptr(pair->cdr), &ret);
if (ret == 0) { /* if exists */
xfprintf(pic, p->file, "#%d#", kh_val(lh, it));
return;
}
else {
xfprintf(pic, p->file, "#%d=", xh_val(e, int));
c = 1;
xh_put_ptr(&p->visited, pic_obj_ptr(pair->cdr), &c);
}
xfprintf(pic, p->file, "#%d=", kh_val(lh, it));
}
else {
xfprintf(pic, p->file, " ");
@ -167,27 +172,25 @@ static void
write_core(struct writer_control *p, pic_value obj)
{
pic_state *pic = p->pic;
khash_t(l) *lh = &p->labels;
khash_t(v) *vh = &p->visited;
xFILE *file = p->file;
size_t i;
xh_entry *e, *it;
int c;
pic_sym *sym;
khiter_t it;
int ret;
#if PIC_ENABLE_FLOAT
double f;
#endif
/* shared objects */
if (pic_vtype(obj) == PIC_VTYPE_HEAP
&& (e = xh_get_ptr(&p->labels, pic_obj_ptr(obj)))
&& xh_val(e, int) != -1) {
if ((xh_get_ptr(&p->visited, pic_obj_ptr(obj)))) {
xfprintf(pic, file, "#%d#", xh_val(e, int));
if (pic_vtype(obj) == PIC_VTYPE_HEAP && ((it = kh_get(l, lh, pic_ptr(obj))) != kh_end(lh)) && kh_val(lh, it) != -1) {
kh_put(v, vh, pic_ptr(obj), &ret);
if (ret == 0) { /* if exists */
xfprintf(pic, file, "#%d#", kh_val(lh, it));
return;
}
else {
xfprintf(pic, file, "#%d=", xh_val(e, int));
c = 1;
xh_put_ptr(&p->visited, pic_obj_ptr(obj), &c);
}
xfprintf(pic, file, "#%d=", kh_val(lh, it));
}
switch (pic_type(obj)) {
@ -297,9 +300,9 @@ write_core(struct writer_control *p, pic_value obj)
break;
case PIC_TT_DICT:
xfprintf(pic, file, "#.(dictionary");
for (it = xh_begin(&pic_dict_ptr(obj)->hash); it != NULL; it = xh_next(it)) {
xfprintf(pic, file, " '%s ", pic_symbol_name(pic, xh_key(it, pic_sym *)));
write_core(p, xh_val(it, pic_value));
pic_dict_for_each (sym, pic_dict_ptr(obj), it) {
xfprintf(pic, file, " '%s ", pic_symbol_name(pic, sym));
write_core(p, pic_dict_ref(pic, pic_dict_ptr(obj), sym));
}
xfprintf(pic, file, ")");
break;