2014-08-25 00:38:09 -04:00
|
|
|
/**
|
|
|
|
* See Copyright Notice in picrin.h
|
|
|
|
*/
|
|
|
|
|
|
|
|
#include "picrin.h"
|
|
|
|
#include "picrin/dict.h"
|
2014-08-30 13:39:09 -04:00
|
|
|
#include "picrin/cont.h"
|
2014-09-13 03:14:33 -04:00
|
|
|
#include "picrin/pair.h"
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2014-09-14 23:39:46 -04:00
|
|
|
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);
|
|
|
|
}
|
|
|
|
|
2014-08-25 00:38:09 -04:00
|
|
|
struct pic_dict *
|
2014-09-12 06:41:20 -04:00
|
|
|
pic_make_dict(pic_state *pic)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
|
|
|
|
|
|
|
dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
|
2014-09-14 23:39:46 -04:00
|
|
|
xh_init_value(pic, &dict->hash);
|
2014-08-25 00:38:09 -04:00
|
|
|
|
|
|
|
return dict;
|
|
|
|
}
|
|
|
|
|
|
|
|
pic_value
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_value key)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
xh_entry *e;
|
|
|
|
|
2014-09-14 23:39:46 -04:00
|
|
|
e = xh_get_value(&dict->hash, key);
|
2014-08-25 00:38:09 -04:00
|
|
|
if (! e) {
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_errorf(pic, "element not found for a key: ~s", key);
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
return xh_val(e, pic_value);
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_value key, pic_value val)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
UNUSED(pic);
|
|
|
|
|
2014-09-14 23:39:46 -04:00
|
|
|
xh_put_value(&dict->hash, key, &val);
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
size_t
|
|
|
|
pic_dict_size(pic_state *pic, struct pic_dict *dict)
|
|
|
|
{
|
|
|
|
UNUSED(pic);
|
|
|
|
|
|
|
|
return dict->hash.count;
|
|
|
|
}
|
|
|
|
|
|
|
|
bool
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_value key)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
UNUSED(pic);
|
|
|
|
|
2014-09-14 23:39:46 -04:00
|
|
|
return xh_get_value(&dict->hash, key) != NULL;
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
void
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_value key)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
2014-09-14 23:39:46 -04:00
|
|
|
if (xh_get_value(&dict->hash, key) == NULL) {
|
|
|
|
pic_errorf(pic, "no slot named ~s found in dictionary", key);
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
2014-09-14 23:39:46 -04:00
|
|
|
xh_del_value(&dict->hash, key);
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_dict_make_dictionary(pic_state *pic)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
|
|
|
|
|
|
|
pic_get_args(pic, "");
|
|
|
|
|
2014-09-12 06:41:20 -04:00
|
|
|
dict = pic_make_dict(pic);
|
2014-08-25 00:38:09 -04:00
|
|
|
|
|
|
|
return pic_obj_value(dict);
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_dict_dictionary(pic_state *pic)
|
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
|
|
|
pic_value *argv;
|
|
|
|
size_t argc, i;
|
|
|
|
|
|
|
|
pic_get_args(pic, "*", &argc, &argv);
|
|
|
|
|
|
|
|
dict = pic_make_dict(pic);
|
|
|
|
|
|
|
|
for (i = 0; i < argc; i += 2) {
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_dict_set(pic, dict, argv[i], argv[i+1]);
|
2014-09-13 03:44:27 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
return pic_obj_value(dict);
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_dict_dictionary_p(pic_state *pic)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
pic_value obj;
|
|
|
|
|
|
|
|
pic_get_args(pic, "o", &obj);
|
|
|
|
|
|
|
|
return pic_bool_value(pic_dict_p(obj));
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_dict_dictionary_ref(pic_state *pic)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_value key;
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_get_args(pic, "do", &dict, &key);
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2014-08-30 13:39:09 -04:00
|
|
|
if (pic_dict_has(pic, dict, key)) {
|
|
|
|
return pic_values2(pic, pic_dict_ref(pic, dict, key), pic_true_value());
|
|
|
|
} else {
|
|
|
|
return pic_values2(pic, pic_none_value(), pic_false_value());
|
|
|
|
}
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_dict_dictionary_set(pic_state *pic)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_value key, val;
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_get_args(pic, "doo", &dict, &key, &val);
|
2014-08-25 00:38:09 -04:00
|
|
|
|
|
|
|
pic_dict_set(pic, dict, key, val);
|
|
|
|
|
|
|
|
return pic_none_value();
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_dict_dictionary_del(pic_state *pic)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_value key;
|
2014-08-25 00:38:09 -04:00
|
|
|
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_get_args(pic, "do", &dict, &key);
|
2014-08-25 00:38:09 -04:00
|
|
|
|
|
|
|
pic_dict_del(pic, dict, key);
|
|
|
|
|
|
|
|
return pic_none_value();
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_dict_dictionary_size(pic_state *pic)
|
2014-08-25 00:38:09 -04:00
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
|
|
|
|
|
|
|
pic_get_args(pic, "d", &dict);
|
|
|
|
|
|
|
|
return pic_int_value(pic_dict_size(pic, dict));
|
|
|
|
}
|
|
|
|
|
2014-09-13 03:22:22 -04:00
|
|
|
static pic_value
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_dict_dictionary_map(pic_state *pic)
|
2014-09-13 03:22:22 -04:00
|
|
|
{
|
|
|
|
struct pic_proc *proc;
|
|
|
|
struct pic_dict *dict;
|
|
|
|
pic_value item, list = pic_nil_value();
|
2014-09-16 03:44:44 -04:00
|
|
|
xh_entry *it;
|
2014-09-13 03:22:22 -04:00
|
|
|
|
|
|
|
pic_get_args(pic, "ld", &proc, &dict);
|
|
|
|
|
2014-09-16 03:44:44 -04:00
|
|
|
for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
|
|
|
|
item = pic_cons(pic, xh_key(it, pic_value), xh_val(it, pic_value));
|
2014-09-13 03:22:22 -04:00
|
|
|
pic_push(pic, pic_apply1(pic, proc, item), list);
|
|
|
|
}
|
|
|
|
|
|
|
|
return pic_reverse(pic, list);
|
|
|
|
}
|
|
|
|
|
2014-09-13 03:14:33 -04:00
|
|
|
static pic_value
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_dict_dictionary_for_each(pic_state *pic)
|
2014-09-13 03:14:33 -04:00
|
|
|
{
|
|
|
|
struct pic_proc *proc;
|
|
|
|
struct pic_dict *dict;
|
|
|
|
pic_value item;
|
2014-09-16 03:44:44 -04:00
|
|
|
xh_entry *it;
|
2014-09-13 03:14:33 -04:00
|
|
|
|
|
|
|
pic_get_args(pic, "ld", &proc, &dict);
|
|
|
|
|
2014-09-16 03:44:44 -04:00
|
|
|
for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
|
2014-09-13 03:14:33 -04:00
|
|
|
int ai = pic_gc_arena_preserve(pic);
|
|
|
|
|
2014-09-16 03:44:44 -04:00
|
|
|
item = pic_cons(pic, xh_key(it, pic_value), xh_val(it, pic_value));
|
2014-09-13 03:14:33 -04:00
|
|
|
pic_apply1(pic, proc, item);
|
|
|
|
|
|
|
|
pic_gc_arena_restore(pic, ai);
|
|
|
|
}
|
|
|
|
|
|
|
|
return pic_none_value();
|
|
|
|
}
|
|
|
|
|
2014-09-13 03:44:27 -04:00
|
|
|
static pic_value
|
|
|
|
pic_dict_dictionary_to_alist(pic_state *pic)
|
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
|
|
|
pic_value item, alist = pic_nil_value();
|
2014-09-16 03:44:44 -04:00
|
|
|
xh_entry *it;
|
2014-09-13 03:44:27 -04:00
|
|
|
|
|
|
|
pic_get_args(pic, "d", &dict);
|
|
|
|
|
2014-09-16 03:44:44 -04:00
|
|
|
for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
|
|
|
|
item = pic_cons(pic, xh_key(it, pic_value), xh_val(it, pic_value));
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_push(pic, item, alist);
|
|
|
|
}
|
|
|
|
|
|
|
|
return pic_reverse(pic, alist);
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_dict_alist_to_dictionary(pic_state *pic)
|
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
|
|
|
pic_value alist, e;
|
|
|
|
|
|
|
|
pic_get_args(pic, "o", &alist);
|
|
|
|
|
|
|
|
dict = pic_make_dict(pic);
|
|
|
|
|
|
|
|
pic_for_each (e, pic_reverse(pic, alist)) {
|
2014-09-14 23:39:46 -04:00
|
|
|
pic_dict_set(pic, dict, pic_car(pic, e), pic_cdr(pic, e));
|
2014-09-13 03:44:27 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
return pic_obj_value(dict);
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_dict_dictionary_to_plist(pic_state *pic)
|
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
|
|
|
pic_value plist = pic_nil_value();
|
2014-09-16 03:44:44 -04:00
|
|
|
xh_entry *it;
|
2014-09-13 03:44:27 -04:00
|
|
|
|
|
|
|
pic_get_args(pic, "d", &dict);
|
|
|
|
|
2014-09-16 03:44:44 -04:00
|
|
|
for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
|
|
|
|
pic_push(pic, xh_key(it, pic_value), plist);
|
|
|
|
pic_push(pic, xh_val(it, pic_value), plist);
|
2014-09-13 03:44:27 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
return pic_reverse(pic, plist);
|
|
|
|
}
|
|
|
|
|
|
|
|
static pic_value
|
|
|
|
pic_dict_plist_to_dictionary(pic_state *pic)
|
|
|
|
{
|
|
|
|
struct pic_dict *dict;
|
|
|
|
pic_value plist, e;
|
|
|
|
|
|
|
|
pic_get_args(pic, "o", &plist);
|
|
|
|
|
|
|
|
dict = pic_make_dict(pic);
|
|
|
|
|
|
|
|
for (e = pic_reverse(pic, plist); ! pic_nil_p(e); e = pic_cddr(pic, e)) {
|
2014-09-14 23:41:51 -04:00
|
|
|
pic_dict_set(pic, dict, pic_cadr(pic, e), pic_car(pic, e));
|
2014-09-13 03:44:27 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
return pic_obj_value(dict);
|
|
|
|
}
|
|
|
|
|
2014-08-25 00:38:09 -04:00
|
|
|
void
|
|
|
|
pic_init_dict(pic_state *pic)
|
|
|
|
{
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_defun(pic, "make-dictionary", pic_dict_make_dictionary);
|
|
|
|
pic_defun(pic, "dictionary?", pic_dict_dictionary_p);
|
|
|
|
pic_defun(pic, "dictionary", pic_dict_dictionary);
|
|
|
|
pic_defun(pic, "dictionary-ref", pic_dict_dictionary_ref);
|
|
|
|
pic_defun(pic, "dictionary-set!", pic_dict_dictionary_set);
|
2014-09-13 03:54:01 -04:00
|
|
|
pic_defun(pic, "dictionary-delete!", pic_dict_dictionary_del);
|
2014-09-13 03:44:27 -04:00
|
|
|
pic_defun(pic, "dictionary-size", pic_dict_dictionary_size);
|
|
|
|
pic_defun(pic, "dictionary-map", pic_dict_dictionary_map);
|
|
|
|
pic_defun(pic, "dictionary-for-each", pic_dict_dictionary_for_each);
|
|
|
|
pic_defun(pic, "dictionary->alist", pic_dict_dictionary_to_alist);
|
|
|
|
pic_defun(pic, "alist->dictionary", pic_dict_alist_to_dictionary);
|
|
|
|
pic_defun(pic, "dictionary->plist", pic_dict_dictionary_to_plist);
|
|
|
|
pic_defun(pic, "plist->dictionary", pic_dict_plist_to_dictionary);
|
2014-08-25 00:38:09 -04:00
|
|
|
}
|