Merge pull request #30 from picrin-scheme/object-dictionary

Object-to-object dictionary
This commit is contained in:
Yuichi Nishiwaki 2014-09-15 12:52:09 +09:00
commit 56b9173a98
6 changed files with 131 additions and 67 deletions

115
dict.c
View File

@ -7,35 +7,96 @@
#include "picrin/cont.h" #include "picrin/cont.h"
#include "picrin/pair.h" #include "picrin/pair.h"
static int
xh_value_hash(const void *key, void *data)
{
union { double f; int i; } u;
pic_value val = *(pic_value *)key;
int hash;
UNUSED(data);
switch (pic_vtype(val)) {
default:
hash = 0;
break;
case PIC_VTYPE_SYMBOL:
hash = pic_sym(val);
break;
case PIC_VTYPE_FLOAT:
u.f = pic_float(val);
hash = u.i;
break;
case PIC_VTYPE_INT:
hash = pic_int(val);
break;
case PIC_VTYPE_HEAP:
hash = (int)pic_ptr(val);
break;
}
return hash + pic_vtype(val);
}
static int
xh_value_equal(const void *key1, const void *key2, void *pic)
{
return pic_equal_p(pic, *(pic_value *)key1, *(pic_value *)key2);
}
static void
xh_init_value(pic_state *pic, xhash *x)
{
xh_init_(x, sizeof(pic_value), sizeof(pic_value), xh_value_hash, xh_value_equal, pic);
}
static inline xh_entry *
xh_get_value(xhash *x, pic_value key)
{
return xh_get_(x, &key);
}
static inline xh_entry *
xh_put_value(xhash *x, pic_value key, void *val)
{
return xh_put_(x, &key, val);
}
static inline void
xh_del_value(xhash *x, pic_value key)
{
xh_del_(x, &key);
}
struct pic_dict * struct pic_dict *
pic_make_dict(pic_state *pic) pic_make_dict(pic_state *pic)
{ {
struct pic_dict *dict; struct pic_dict *dict;
dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT); dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
xh_init_int(&dict->hash, sizeof(pic_value)); xh_init_value(pic, &dict->hash);
return dict; return dict;
} }
pic_value pic_value
pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_sym key) pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_value key)
{ {
xh_entry *e; xh_entry *e;
e = xh_get_int(&dict->hash, key); e = xh_get_value(&dict->hash, key);
if (! e) { if (! e) {
pic_errorf(pic, "element not found for a key: ~s", pic_sym_value(key)); pic_errorf(pic, "element not found for a key: ~s", key);
} }
return xh_val(e, pic_value); return xh_val(e, pic_value);
} }
void void
pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_sym key, pic_value val) pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_value key, pic_value val)
{ {
UNUSED(pic); UNUSED(pic);
xh_put_int(&dict->hash, key, &val); xh_put_value(&dict->hash, key, &val);
} }
size_t size_t
@ -47,21 +108,21 @@ pic_dict_size(pic_state *pic, struct pic_dict *dict)
} }
bool bool
pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_sym key) pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_value key)
{ {
UNUSED(pic); UNUSED(pic);
return xh_get_int(&dict->hash, key) != NULL; return xh_get_value(&dict->hash, key) != NULL;
} }
void void
pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_sym key) pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_value key)
{ {
if (xh_get_int(&dict->hash, key) == NULL) { if (xh_get_value(&dict->hash, key) == NULL) {
pic_errorf(pic, "no slot named ~s found in dictionary", pic_sym_value(key)); pic_errorf(pic, "no slot named ~s found in dictionary", key);
} }
xh_del_int(&dict->hash, key); xh_del_value(&dict->hash, key);
} }
static pic_value static pic_value
@ -88,8 +149,7 @@ pic_dict_dictionary(pic_state *pic)
dict = pic_make_dict(pic); dict = pic_make_dict(pic);
for (i = 0; i < argc; i += 2) { for (i = 0; i < argc; i += 2) {
pic_assert_type(pic, argv[i], sym); pic_dict_set(pic, dict, argv[i], argv[i+1]);
pic_dict_set(pic, dict, pic_sym(argv[i]), argv[i+1]);
} }
return pic_obj_value(dict); return pic_obj_value(dict);
@ -109,9 +169,9 @@ static pic_value
pic_dict_dictionary_ref(pic_state *pic) pic_dict_dictionary_ref(pic_state *pic)
{ {
struct pic_dict *dict; struct pic_dict *dict;
pic_sym key; pic_value key;
pic_get_args(pic, "dm", &dict, &key); pic_get_args(pic, "do", &dict, &key);
if (pic_dict_has(pic, dict, key)) { if (pic_dict_has(pic, dict, key)) {
return pic_values2(pic, pic_dict_ref(pic, dict, key), pic_true_value()); return pic_values2(pic, pic_dict_ref(pic, dict, key), pic_true_value());
@ -124,10 +184,9 @@ static pic_value
pic_dict_dictionary_set(pic_state *pic) pic_dict_dictionary_set(pic_state *pic)
{ {
struct pic_dict *dict; struct pic_dict *dict;
pic_sym key; pic_value key, val;
pic_value val;
pic_get_args(pic, "dmo", &dict, &key, &val); pic_get_args(pic, "doo", &dict, &key, &val);
pic_dict_set(pic, dict, key, val); pic_dict_set(pic, dict, key, val);
@ -138,9 +197,9 @@ static pic_value
pic_dict_dictionary_del(pic_state *pic) pic_dict_dictionary_del(pic_state *pic)
{ {
struct pic_dict *dict; struct pic_dict *dict;
pic_sym key; pic_value key;
pic_get_args(pic, "dm", &dict, &key); pic_get_args(pic, "do", &dict, &key);
pic_dict_del(pic, dict, key); pic_dict_del(pic, dict, key);
@ -169,7 +228,7 @@ pic_dict_dictionary_map(pic_state *pic)
xh_begin(&it, &dict->hash); xh_begin(&it, &dict->hash);
while (xh_next(&it)) { while (xh_next(&it)) {
item = pic_cons(pic, pic_sym_value(xh_key(it.e, pic_sym)), xh_val(it.e, pic_value)); item = pic_cons(pic, xh_key(it.e, pic_value), xh_val(it.e, pic_value));
pic_push(pic, pic_apply1(pic, proc, item), list); pic_push(pic, pic_apply1(pic, proc, item), list);
} }
@ -190,7 +249,7 @@ pic_dict_dictionary_for_each(pic_state *pic)
while (xh_next(&it)) { while (xh_next(&it)) {
int ai = pic_gc_arena_preserve(pic); int ai = pic_gc_arena_preserve(pic);
item = pic_cons(pic, pic_sym_value(xh_key(it.e, pic_sym)), xh_val(it.e, pic_value)); item = pic_cons(pic, xh_key(it.e, pic_value), xh_val(it.e, pic_value));
pic_apply1(pic, proc, item); pic_apply1(pic, proc, item);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
@ -210,7 +269,7 @@ pic_dict_dictionary_to_alist(pic_state *pic)
xh_begin(&it, &dict->hash); xh_begin(&it, &dict->hash);
while (xh_next(&it)) { while (xh_next(&it)) {
item = pic_cons(pic, pic_sym_value(xh_key(it.e, pic_sym)), xh_val(it.e, pic_value)); item = pic_cons(pic, xh_key(it.e, pic_value), xh_val(it.e, pic_value));
pic_push(pic, item, alist); pic_push(pic, item, alist);
} }
@ -228,8 +287,7 @@ pic_dict_alist_to_dictionary(pic_state *pic)
dict = pic_make_dict(pic); dict = pic_make_dict(pic);
pic_for_each (e, pic_reverse(pic, alist)) { pic_for_each (e, pic_reverse(pic, alist)) {
pic_assert_type(pic, pic_car(pic, e), sym); pic_dict_set(pic, dict, pic_car(pic, e), pic_cdr(pic, e));
pic_dict_set(pic, dict, pic_sym(pic_car(pic, e)), pic_cdr(pic, e));
} }
return pic_obj_value(dict); return pic_obj_value(dict);
@ -246,8 +304,8 @@ pic_dict_dictionary_to_plist(pic_state *pic)
xh_begin(&it, &dict->hash); xh_begin(&it, &dict->hash);
while (xh_next(&it)) { while (xh_next(&it)) {
pic_push(pic, xh_key(it.e, pic_value), plist);
pic_push(pic, xh_val(it.e, pic_value), plist); pic_push(pic, xh_val(it.e, pic_value), plist);
pic_push(pic, pic_sym_value(xh_key(it.e, pic_sym)), plist);
} }
return pic_reverse(pic, plist); return pic_reverse(pic, plist);
@ -264,8 +322,7 @@ pic_dict_plist_to_dictionary(pic_state *pic)
dict = pic_make_dict(pic); dict = pic_make_dict(pic);
for (e = pic_reverse(pic, plist); ! pic_nil_p(e); e = pic_cddr(pic, e)) { for (e = pic_reverse(pic, plist); ! pic_nil_p(e); e = pic_cddr(pic, e)) {
pic_assert_type(pic, pic_car(pic, e), sym); pic_dict_set(pic, dict, pic_cadr(pic, e), pic_car(pic, e));
pic_dict_set(pic, dict, pic_sym(pic_car(pic, e)), pic_cadr(pic, e));
} }
return pic_obj_value(dict); return pic_obj_value(dict);

1
gc.c
View File

@ -498,6 +498,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
xh_begin(&it, &dict->hash); xh_begin(&it, &dict->hash);
while (xh_next(&it)) { while (xh_next(&it)) {
gc_mark(pic, xh_key(it.e, pic_value));
gc_mark(pic, xh_val(it.e, pic_value)); gc_mark(pic, xh_val(it.e, pic_value));
} }
break; break;

View File

@ -19,11 +19,11 @@ struct pic_dict {
struct pic_dict *pic_make_dict(pic_state *); struct pic_dict *pic_make_dict(pic_state *);
pic_value pic_dict_ref(pic_state *, struct pic_dict *, pic_sym); pic_value pic_dict_ref(pic_state *, struct pic_dict *, pic_value);
void pic_dict_set(pic_state *, struct pic_dict *, pic_sym, pic_value); void pic_dict_set(pic_state *, struct pic_dict *, pic_value, pic_value);
void pic_dict_del(pic_state *, struct pic_dict *, pic_sym); void pic_dict_del(pic_state *, struct pic_dict *, pic_value);
size_t pic_dict_size(pic_state *, struct pic_dict *); size_t pic_dict_size(pic_state *, struct pic_dict *);
bool pic_dict_has(pic_state *, struct pic_dict *, pic_sym); bool pic_dict_has(pic_state *, struct pic_dict *, pic_value);
#if defined(__cplusplus) #if defined(__cplusplus)
} }

66
lib.c
View File

@ -7,7 +7,6 @@
#include "picrin/pair.h" #include "picrin/pair.h"
#include "picrin/macro.h" #include "picrin/macro.h"
#include "picrin/error.h" #include "picrin/error.h"
#include "picrin/dict.h"
#include "picrin/string.h" #include "picrin/string.h"
#include "picrin/proc.h" #include "picrin/proc.h"
@ -65,55 +64,54 @@ pic_find_library(pic_state *pic, pic_value spec)
return pic_lib_ptr(pic_cdr(pic, v)); return pic_lib_ptr(pic_cdr(pic, v));
} }
static struct pic_dict * static void
import_table(pic_state *pic, pic_value spec) import_table(pic_state *pic, pic_value spec, xhash *imports)
{ {
const pic_sym sONLY = pic_intern_cstr(pic, "only"); const pic_sym sONLY = pic_intern_cstr(pic, "only");
const pic_sym sRENAME = pic_intern_cstr(pic, "rename"); const pic_sym sRENAME = pic_intern_cstr(pic, "rename");
const pic_sym sPREFIX = pic_intern_cstr(pic, "prefix"); const pic_sym sPREFIX = pic_intern_cstr(pic, "prefix");
const pic_sym sEXCEPT = pic_intern_cstr(pic, "except"); const pic_sym sEXCEPT = pic_intern_cstr(pic, "except");
struct pic_lib *lib; struct pic_lib *lib;
struct pic_dict *imports, *dict; xhash table;
pic_value val, id; pic_value val;
pic_sym sym; pic_sym sym, id;
xh_iter it; xh_iter it;
imports = pic_make_dict(pic); xh_init_int(&table, sizeof(pic_sym));
if (pic_list_p(spec)) { if (pic_list_p(spec)) {
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sONLY))) { if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sONLY))) {
dict = import_table(pic, pic_cadr(pic, spec)); import_table(pic, pic_cadr(pic, spec), &table);
pic_for_each (val, pic_cddr(pic, spec)) { pic_for_each (val, pic_cddr(pic, spec)) {
pic_dict_set(pic, imports, pic_sym(val), pic_dict_ref(pic, dict, pic_sym(val))); xh_put_int(imports, pic_sym(val), &xh_val(xh_get_int(&table, pic_sym(val)), pic_sym));
} }
return imports; goto exit;
} }
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME))) { if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sRENAME))) {
imports = import_table(pic, pic_cadr(pic, spec)); import_table(pic, pic_cadr(pic, spec), imports);
pic_for_each (val, pic_cddr(pic, spec)) { pic_for_each (val, pic_cddr(pic, spec)) {
id = pic_dict_ref(pic, imports, pic_sym(pic_car(pic, val))); id = xh_val(xh_get_int(imports, pic_sym(pic_car(pic, val))), pic_sym);
pic_dict_del(pic, imports, pic_sym(pic_car(pic, val))); xh_del_int(imports, pic_sym(pic_car(pic, val)));
pic_dict_set(pic, imports, pic_sym(pic_cadr(pic, val)), id); xh_put_int(imports, pic_sym(pic_cadr(pic, val)), &id);
} }
return imports; goto exit;
} }
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sPREFIX))) { if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sPREFIX))) {
dict = import_table(pic, pic_cadr(pic, spec)); import_table(pic, pic_cadr(pic, spec), &table);
xh_begin(&it, &dict->hash); xh_begin(&it, &table);
while (xh_next(&it)) { while (xh_next(&it)) {
id = pic_sym_value(xh_key(it.e, pic_sym));
val = pic_list_ref(pic, spec, 2); val = pic_list_ref(pic, spec, 2);
sym = pic_intern_str(pic, pic_format(pic, "~s~s", val, id)); sym = pic_intern_str(pic, pic_format(pic, "~s~s", val, pic_sym_value(xh_key(it.e, pic_sym))));
pic_dict_set(pic, imports, sym, xh_val(it.e, pic_value)); xh_put_int(imports, sym, &xh_val(it.e, pic_sym));
} }
return imports; goto exit;
} }
if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sEXCEPT))) { if (pic_eq_p(pic_car(pic, spec), pic_sym_value(sEXCEPT))) {
imports = import_table(pic, pic_cadr(pic, spec)); import_table(pic, pic_cadr(pic, spec), imports);
pic_for_each (val, pic_cddr(pic, spec)) { pic_for_each (val, pic_cddr(pic, spec)) {
pic_dict_del(pic, imports, pic_sym(val)); xh_del_int(imports, pic_sym(val));
} }
return imports; goto exit;
} }
} }
lib = pic_find_library(pic, spec); lib = pic_find_library(pic, spec);
@ -122,28 +120,34 @@ import_table(pic_state *pic, pic_value spec)
} }
xh_begin(&it, &lib->exports); xh_begin(&it, &lib->exports);
while (xh_next(&it)) { while (xh_next(&it)) {
pic_dict_set(pic, imports, xh_key(it.e, pic_sym), pic_sym_value(xh_val(it.e, pic_sym))); xh_put_int(imports, xh_key(it.e, pic_sym), &xh_val(it.e, pic_sym));
} }
return imports;
exit:
xh_destroy(&table);
} }
static void static void
import(pic_state *pic, pic_value spec) import(pic_state *pic, pic_value spec)
{ {
struct pic_dict *imports; xhash imports;
xh_iter it; xh_iter it;
imports = import_table(pic, spec); xh_init_int(&imports, sizeof(pic_sym)); /* pic_sym to pic_sym */
xh_begin(&it, &imports->hash); import_table(pic, spec, &imports);
xh_begin(&it, &imports);
while (xh_next(&it)) { while (xh_next(&it)) {
#if DEBUG #if DEBUG
printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, pic_sym(xh_val(it.e, pic_value)))); printf("* importing %s as %s\n", pic_symbol_name(pic, xh_key(it.e, pic_sym)), pic_symbol_name(pic, xh_val(it.e, pic_sym)));
#endif #endif
pic_put_rename(pic, pic->lib->env, xh_key(it.e, pic_sym), pic_sym(xh_val(it.e, pic_value))); pic_put_rename(pic, pic->lib->env, xh_key(it.e, pic_sym), xh_val(it.e, pic_sym));
} }
xh_destroy(&imports);
} }
static void static void

4
proc.c
View File

@ -61,13 +61,13 @@ pic_attr(pic_state *pic, struct pic_proc *proc)
pic_value pic_value
pic_attr_ref(pic_state *pic, struct pic_proc *proc, const char *key) pic_attr_ref(pic_state *pic, struct pic_proc *proc, const char *key)
{ {
return pic_dict_ref(pic, pic_attr(pic, proc), pic_intern_cstr(pic, key)); return pic_dict_ref(pic, pic_attr(pic, proc), pic_sym_value(pic_intern_cstr(pic, key)));
} }
void void
pic_attr_set(pic_state *pic, struct pic_proc *proc, const char *key, pic_value v) pic_attr_set(pic_state *pic, struct pic_proc *proc, const char *key, pic_value v)
{ {
pic_dict_set(pic, pic_attr(pic, proc), pic_intern_cstr(pic, key), v); pic_dict_set(pic, pic_attr(pic, proc), pic_sym_value(pic_intern_cstr(pic, key)), v);
} }
static pic_value static pic_value

View File

@ -336,7 +336,9 @@ write_core(struct writer_control *p, pic_value obj)
xfprintf(file, "#.(dictionary"); xfprintf(file, "#.(dictionary");
xh_begin(&it, &pic_dict_ptr(obj)->hash); xh_begin(&it, &pic_dict_ptr(obj)->hash);
while (xh_next(&it)) { while (xh_next(&it)) {
xfprintf(file, " '%s ", pic_symbol_name(pic, xh_key(it.e, pic_sym))); xfprintf(file, " '");
write_core(p, xh_key(it.e, pic_value));
xfprintf(file, " '");
write_core(p, xh_val(it.e, pic_value)); write_core(p, xh_val(it.e, pic_value));
} }
xfprintf(file, ")"); xfprintf(file, ")");